From d0d162c2d63600435622ad4cb5e67e98d1a36da4 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 27 Aug 2018 18:27:01 -0400 Subject: [PATCH 01/26] Small checkdoc quoting fix (bug#32546) * lisp/emacs-lisp/checkdoc.el (checkdoc-this-string-valid-engine): Fix quoting thinko. --- lisp/emacs-lisp/checkdoc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 4e8ecba4a15..f2bf15d72de 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1868,7 +1868,7 @@ Replace with \"%s\"? " original replace) (if (checkdoc-autofix-ask-replace (match-beginning 1) (+ (match-beginning 1) (length ms)) - msg (format-message "`%s'" ms) t) + msg (format "`%s'" ms) t) (setq msg nil) (setq msg (format-message From 2695b7e74559318cee2b4e69c2f94ac22421d134 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 27 Aug 2018 21:44:29 -0400 Subject: [PATCH 02/26] * configure.ac: Doc fixes related to --with-xim. --- configure.ac | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/configure.ac b/configure.ac index 3d39cd0c3ba..868930bb5ed 100644 --- a/configure.ac +++ b/configure.ac @@ -362,7 +362,7 @@ OPTION_DEFAULT_ON([m17n-flt],[don't use m17n-flt for text shaping]) OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif or Xaw3d scroll bars]) OPTION_DEFAULT_ON([xaw3d],[don't use Xaw3d]) -OPTION_DEFAULT_ON([xim],[don't use X11 XIM]) +OPTION_DEFAULT_ON([xim],[at runtime, default X11 XIM to off]) AC_ARG_WITH([ns],[AS_HELP_STRING([--with-ns], [use Nextstep (macOS Cocoa or GNUstep) windowing system. On by default on macOS.])],[],[with_ns=maybe]) @@ -3149,11 +3149,12 @@ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ AC_DEFINE(HAVE_XIM, 1, [Define to 1 if XIM is available])], HAVE_XIM=no) -dnl '--with-xim' now controls only the initial value of use_xim at run time. - +dnl Note this is non-standard. --with-xim does not control whether +dnl XIM support is compiled in, it only affects the runtime default of +dnl use_xim in xterm.c. if test "${with_xim}" != "no"; then AC_DEFINE(USE_XIM, 1, - [Define to 1 if we should use XIM, if it is available.]) + [Define to 1 to default runtime use of XIM to on.]) fi From 785682c26df4ced5c62075c88477b7bc50afb332 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Mon, 27 Aug 2018 21:46:14 -0400 Subject: [PATCH 03/26] * configure.ac (emacs_config_features): Add GLIB, XDBE, XIM. --- configure.ac | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/configure.ac b/configure.ac index 868930bb5ed..4dadf661d8c 100644 --- a/configure.ac +++ b/configure.ac @@ -5367,12 +5367,13 @@ Configured for '${canonical}'. optsep= emacs_config_features= for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \ - GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \ - LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \ - THREADS XWIDGETS LIBSYSTEMD CANNOT_DUMP LCMS2; do + GCONF GSETTINGS GLIB NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \ + LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 XDBE XIM \ + NS MODULES THREADS XWIDGETS LIBSYSTEMD CANNOT_DUMP LCMS2; do case $opt in CANNOT_DUMP) eval val=\${$opt} ;; + GLIB) val=${emacs_cv_links_glib} ;; NOTIFY|ACL) eval val=\${${opt}_SUMMARY} ;; TOOLKIT_SCROLL_BARS|X_TOOLKIT) eval val=\${USE_$opt} ;; THREADS) val=${threads_enabled} ;; From 63e59c8ca51ced6c4d5951281cb21288da32ced3 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 28 Aug 2018 10:20:46 +0300 Subject: [PATCH 04/26] Avoid crashes in malformed defvar * src/eval.c (Fdefvar): Don't call XSYMBOL on something that might not be a symbol. This avoids crashes due to malformed 'defvar' forms. (Bug#32552) --- src/eval.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/eval.c b/src/eval.c index 40cba3bb1ce..f9563a3f80c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -773,7 +773,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) LOADHIST_ATTACH (sym); } else if (!NILP (Vinternal_interpreter_environment) - && !XSYMBOL (sym)->u.s.declared_special) + && (SYMBOLP (sym) && !XSYMBOL (sym)->u.s.declared_special)) /* A simple (defvar foo) with lexical scoping does "nothing" except declare that var to be dynamically scoped *locally* (i.e. within the current file or let-block). */ From fe06fcc5955731b1373aa74a586da04f5c2c11f7 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Tue, 28 Aug 2018 14:11:12 +0300 Subject: [PATCH 05/26] Avoid infinite hscrolling loops when line numbers are displayed * src/xdisp.c (maybe_produce_line_number): Don't produce line numbers if we don't have enough screen estate. (Bug#32351) --- src/xdisp.c | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/src/xdisp.c b/src/xdisp.c index 9a82953952f..eccefa41cf3 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -21166,8 +21166,12 @@ maybe_produce_line_number (struct it *it) an L2R paragraph. */ tem_it.bidi_it.resolved_level = 2; + /* We must leave space for 2 glyphs for continuation and truncation, + and at least one glyph for buffer text. */ + int width_limit = + tem_it.last_visible_x - tem_it.first_visible_x + - 3 * FRAME_COLUMN_WIDTH (it->f); /* Produce glyphs for the line number in a scratch glyph_row. */ - int n_glyphs_before; for (const char *p = lnum_buf; *p; p++) { /* For continuation lines and lines after ZV, instead of a line @@ -21191,18 +21195,18 @@ maybe_produce_line_number (struct it *it) else tem_it.c = tem_it.char_to_display = *p; tem_it.len = 1; - n_glyphs_before = scratch_glyph_row.used[TEXT_AREA]; /* Make sure these glyphs will have a "position" of -1. */ SET_TEXT_POS (tem_it.position, -1, -1); PRODUCE_GLYPHS (&tem_it); - /* Stop producing glyphs if we don't have enough space on - this line. FIXME: should we refrain from producing the - line number at all in that case? */ - if (tem_it.current_x > tem_it.last_visible_x) + /* Stop producing glyphs, and refrain from producing the line + number, if we don't have enough space on this line. */ + if (tem_it.current_x >= width_limit) { - scratch_glyph_row.used[TEXT_AREA] = n_glyphs_before; - break; + it->lnum_width = 0; + it->lnum_pixel_width = 0; + bidi_unshelve_cache (itdata, false); + return; } } From fca935e4abe817130abb2676ec2f37b73e4f45f4 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 14 Feb 2018 19:58:07 -0500 Subject: [PATCH 06/26] ; Let pre-commit git hook check merged in changes (Bug#29197) * build-aux/git-hooks/pre-commit: If GIT_MERGE_CHECK_OTHER is 'true', check changes against the merge target, rather than the current branch. Include file name when giving error message about non-standard characters. --- build-aux/git-hooks/pre-commit | 16 +++++++--------- 1 file changed, 7 insertions(+), 9 deletions(-) diff --git a/build-aux/git-hooks/pre-commit b/build-aux/git-hooks/pre-commit index 5e42dab233b..c0455fb2fa2 100755 --- a/build-aux/git-hooks/pre-commit +++ b/build-aux/git-hooks/pre-commit @@ -28,7 +28,7 @@ exec >&2 # When doing a two-way merge, ignore problems that came from the other # side of the merge. head=HEAD -if test -r "$GIT_DIR"/MERGE_HEAD; then +if test -r "$GIT_DIR"/MERGE_HEAD && test "$GIT_MERGE_CHECK_OTHER" != true; then merge_heads=`cat "$GIT_DIR"/MERGE_HEAD` || exit for merge_head in $merge_heads; do case $head in @@ -42,15 +42,10 @@ if test -r "$GIT_DIR"/MERGE_HEAD; then fi git_diff='git diff --cached --name-only --diff-filter=A' -ok_chars='\0+[=-=]./0-9A-Z_a-z' -nbadchars=`$git_diff -z $head | tr -d "$ok_chars" | wc -c` -if test "$nbadchars" -ne 0; then - echo "File name does not consist of -+./_ or ASCII letters or digits." - exit 1 -fi - -for new_name in `$git_diff $head`; do +# 'git diff' will backslash escape tabs and newlines, so we don't have +# to worry about word splitting here. +$git_diff $head | sane_egrep 'ChangeLog|^-|/-|[^-+./_0-9A-Z_a-z]' | while IFS= read -r new_name; do case $new_name in -* | */-*) echo "$new_name: File name component begins with '-'." @@ -58,6 +53,9 @@ for new_name in `$git_diff $head`; do ChangeLog | */ChangeLog) echo "$new_name: Please use git commit messages, not ChangeLog files." exit 1;; + *) + echo "$new_name: File name does not consist of -+./_ or ASCII letters or digits." + exit 1;; esac done From f0888179237b25e32b46a8a855acb3d3453e4c69 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Tue, 14 Aug 2018 23:26:50 -0400 Subject: [PATCH 07/26] Fix math-imaginary-i check MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Reported by Bastian Erdnüß at . * lisp/calc/calc-cplx.el (math-imaginary-i): Check for a value of (polar 1 ). --- lisp/calc/calc-cplx.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el index 4a453a73d72..35cd31dfb4f 100644 --- a/lisp/calc/calc-cplx.el +++ b/lisp/calc/calc-cplx.el @@ -273,8 +273,8 @@ (or (eq (car-safe val) 'special-const) (equal val '(cplx 0 1)) (and (eq (car-safe val) 'polar) - (eq (nth 1 val) 0) - (Math-equal (nth 1 val) (math-quarter-circle nil)))))) + (eq (nth 1 val) 1) + (Math-equal (nth 2 val) (math-quarter-circle nil)))))) ;;; Extract the real or complex part of a complex number. [R N] [Public] ;;; Also extracts the real part of a modulo form. From 9d613444994a2e5827c23e8c0a5e2a975903764f Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Tue, 28 Aug 2018 07:49:49 -0400 Subject: [PATCH 08/26] Index profiler commands in elisp manual * doc/lispref/debugging.texi (Profiling): Add index entries for profiler-start, profiler-report, profiler-stop. --- doc/lispref/debugging.texi | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index fdd92a3780e..cbf8778ca8b 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -930,6 +930,9 @@ the execution time. If you find that one particular function is responsible for a significant portion of the execution time, you can start looking for ways to optimize that piece. +@findex profiler-start +@findex profiler-report +@findex profiler-stop Emacs has built-in support for this. To begin profiling, type @kbd{M-x profiler-start}. You can choose to profile by processor usage, memory usage, or both. Then run the code you'd like to speed From 3764ab4186bb4479aee5241705f91c1edf4cccfb Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 28 Aug 2018 16:05:04 -0400 Subject: [PATCH 09/26] * etc/PROBLEMS: New entry about GTK+ 3 crash with some X servers. --- etc/PROBLEMS | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 9507a5d9758..15e2b3359d4 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -217,6 +217,26 @@ result in an endless loop. If you need Emacs to be able to recover from closing displays, compile it with the Lucid toolkit instead of GTK. +** Emacs compiled with GTK+ 3 crashes when run under some X servers. +This happens when the X server does not provide certain display +features that the underlying GTK+ 3 toolkit assumes. For example, this +issue has been seen with remote X servers like X2Go. The symptoms +are an Emacs crash, possibly triggered by the mouse entering the Emacs +window, or an attempt to resize the Emacs window. The crash backtrace +contains a call to XQueryPointer. + +This issue was fixed in the GTK+ 3 toolkit in commit 4b1c0256 in February 2018. + +If your GTK+ 3 is still affected, you can avoid the issue by recompiling +Emacs with a different X toolkit, eg --with-toolkit=gtk2. + +References: +https://gitlab.gnome.org/GNOME/gtk/commit/4b1c02560f0d8097bf5a11932e52fb72f3e9e94b +https://debbugs.gnu.org/24280 +https://bugs.debian.org/901038 +https://bugzilla.redhat.com/1483942 +https://access.redhat.com/solutions/3410101 + ** Emacs compiled with GTK crashes at startup due to X protocol error. This is known to happen on elementary OS GNU/Linux systems. From 3b71befdfb2e073d025471133be87d4d4d853708 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 28 Aug 2018 16:34:25 -0400 Subject: [PATCH 10/26] admin.el: respect environment settings for makeinfo etc * admin/admin.el (manual-makeinfo, manual-texi2pdf, manual-texi2dvi): New variables. (manual-html-mono, manual-html-node, manual-pdf, manual-ps): Use them. --- admin/admin.el | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/admin/admin.el b/admin/admin.el index 3cb5dbc2d92..1cad7ae2776 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -352,13 +352,22 @@ Optional argument TYPE is type of output (nil means all)." (manual-html-mono texi (expand-file-name (concat name ".html") html-mono-dir)))) +(defvar manual-makeinfo (or (getenv "MAKEINFO") "makeinfo") + "The `makeinfo' program to use.") + +(defvar manual-texi2pdf (or (getenv "TEXI2PDF") "texi2pdf") + "The `texi2pdf' program to use.") + +(defvar manual-texi2dvi (or (getenv "TEXI2DVI") "texi2dvi") + "The `texi2dvi' program to use.") + (defun manual-html-mono (texi-file dest) "Run Makeinfo on TEXI-FILE, emitting mono HTML output to DEST. This function also edits the HTML files so that they validate as HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using the @import directive." (make-directory (or (file-name-directory dest) ".") t) - (call-process "makeinfo" nil nil nil + (call-process manual-makeinfo nil nil nil "-D" "WWW_GNU_ORG" "-I" (expand-file-name "../emacs" (file-name-directory texi-file)) @@ -386,7 +395,7 @@ the @import directive." (unless (file-exists-p texi-file) (user-error "Manual file %s not found" texi-file)) (make-directory dir t) - (call-process "makeinfo" nil nil nil + (call-process manual-makeinfo nil nil nil "-D" "WWW_GNU_ORG" "-I" (expand-file-name "../emacs" (file-name-directory texi-file)) @@ -425,7 +434,7 @@ the @import directive." "Run texi2pdf on TEXI-FILE, emitting PDF output to DEST." (make-directory (or (file-name-directory dest) ".") t) (let ((default-directory (file-name-directory texi-file))) - (call-process "texi2pdf" nil nil nil + (call-process manual-texi2pdf nil nil nil "-I" "../emacs" "-I" "../misc" texi-file "-o" dest))) @@ -435,7 +444,7 @@ the @import directive." (let ((dvi-dest (concat (file-name-sans-extension dest) ".dvi")) (default-directory (file-name-directory texi-file))) ;; FIXME: Use `texi2dvi --ps'? --xfq - (call-process "texi2dvi" nil nil nil + (call-process manual-texi2dvi nil nil nil "-I" "../emacs" "-I" "../misc" texi-file "-o" dvi-dest) (call-process "dvips" nil nil nil dvi-dest "-o" dest) From 2670cbf9a87eb498d73770c381ca51657d390a1e Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 28 Aug 2018 21:03:12 -0400 Subject: [PATCH 11/26] ; * configure.ac: Remove outdated comment (it was about CRT_DIR). --- configure.ac | 1 - 1 file changed, 1 deletion(-) diff --git a/configure.ac b/configure.ac index 4dadf661d8c..029f451cd4a 100644 --- a/configure.ac +++ b/configure.ac @@ -1575,7 +1575,6 @@ case $opsys in LIB_MATH= SYSTEM_TYPE=windows-nt ;; - dnl NB this may be adjusted below. netbsd | openbsd ) SYSTEM_TYPE=berkeley-unix ;; From b28d5333e0144acc7385339578d907196c4b6f3e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 29 Aug 2018 10:43:41 -0400 Subject: [PATCH 12/26] * src/keymap.c: Make better use of access_keymap's functionality (Flookup_key): Allow `keymap' to be a list of keymaps. (Fcommand_remapping, Fkey_binding): Simplify accordingly. (shadow_lookup, describe_map_tree): Simplify. --- etc/NEWS | 2 ++ src/keymap.c | 93 +++++++++++++++++----------------------------------- 2 files changed, 32 insertions(+), 63 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index ed7be1fc206..8a774d81c5b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -865,6 +865,8 @@ removed. * Lisp Changes in Emacs 27.1 +** lookup-key can take a list of keymaps as argument. + +++ ** New function 'proper-list-p'. Given a proper list as argument, this predicate returns its length; diff --git a/src/keymap.c b/src/keymap.c index bdd3af2cdcc..52db7b491f9 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1186,7 +1186,7 @@ number or marker, in which case the keymap properties at the specified buffer position instead of point are used. The KEYMAPS argument is ignored if POSITION is non-nil. -If the optional argument KEYMAPS is non-nil, it should be a list of +If the optional argument KEYMAPS is non-nil, it should be a keymap or list of keymaps to search for command remapping. Otherwise, search for the remapping in all currently active keymaps. */) (Lisp_Object command, Lisp_Object position, Lisp_Object keymaps) @@ -1199,8 +1199,7 @@ remapping in all currently active keymaps. */) if (NILP (keymaps)) command = Fkey_binding (command_remapping_vector, Qnil, Qt, position); else - command = Flookup_key (Fcons (Qkeymap, keymaps), - command_remapping_vector, Qnil); + command = Flookup_key (keymaps, command_remapping_vector, Qnil); return FIXNUMP (command) ? Qnil : command; } @@ -1208,7 +1207,7 @@ remapping in all currently active keymaps. */) /* GC is possible in this function. */ DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0, - doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition. + doc: /* Look up key sequence KEY in KEYMAP. Return the definition. A value of nil means undefined. See doc of `define-key' for kinds of definitions. @@ -1217,6 +1216,7 @@ that is, characters or symbols in it except for the last one fail to be a valid sequence of prefix characters in KEYMAP. The number is how many characters at the front of KEY it takes to reach a non-prefix key. +KEYMAP can also be a list of keymaps. Normally, `lookup-key' ignores bindings for t, which act as default bindings, used when nothing else in the keymap applies; this makes it @@ -1231,7 +1231,8 @@ recognize the default bindings, just as `read-key-sequence' does. */) ptrdiff_t length; bool t_ok = !NILP (accept_default); - keymap = get_keymap (keymap, 1, 1); + if (!CONSP (keymap) && !NILP (keymap)) + keymap = get_keymap (keymap, true, true); length = CHECK_VECTOR_OR_STRING (key); if (length == 0) @@ -1664,7 +1665,7 @@ specified buffer position instead of point are used. } } - value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)), + value = Flookup_key (Fcurrent_active_maps (Qt, position), key, accept_default); if (NILP (value) || FIXNUMP (value)) @@ -2359,39 +2360,24 @@ preferred_sequence_p (Lisp_Object seq) static void where_is_internal_1 (Lisp_Object key, Lisp_Object binding, Lisp_Object args, void *data); -/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map. - Returns the first non-nil binding found in any of those maps. - If REMAP is true, pass the result of the lookup through command - remapping before returning it. */ +/* Like Flookup_key, but with command remapping; just returns nil + if the key sequence is too long. */ static Lisp_Object -shadow_lookup (Lisp_Object shadow, Lisp_Object key, Lisp_Object flag, +shadow_lookup (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default, bool remap) { - Lisp_Object tail, value; + Lisp_Object value = Flookup_key (keymap, key, accept_default); - for (tail = shadow; CONSP (tail); tail = XCDR (tail)) + if (FIXNATP (value)) /* `key' is too long! */ + return Qnil; + else if (!NILP (value) && remap && SYMBOLP (value)) { - value = Flookup_key (XCAR (tail), key, flag); - if (FIXNATP (value)) - { - value = Flookup_key (XCAR (tail), - Fsubstring (key, make_fixnum (0), value), flag); - if (!NILP (value)) - return Qnil; - } - else if (!NILP (value)) - { - Lisp_Object remapping; - if (remap && SYMBOLP (value) - && (remapping = Fcommand_remapping (value, Qnil, shadow), - !NILP (remapping))) - return remapping; - else - return value; - } + Lisp_Object remapping = Fcommand_remapping (value, Qnil, keymap); + return (!NILP (remapping) ? remapping : value); } - return Qnil; + else + return value; } static Lisp_Object Vmouse_events; @@ -2565,7 +2551,7 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: keymaps = Fcurrent_active_maps (Qnil, Qnil); tem = Fcommand_remapping (definition, Qnil, keymaps); - /* If `definition' is remapped to tem', then OT1H no key will run + /* If `definition' is remapped to `tem', then OT1H no key will run that command (since they will run `tem' instead), so we should return nil; but OTOH all keys bound to `definition' (or to `tem') will run the same command. @@ -2587,6 +2573,8 @@ The optional 5th arg NO-REMAP alters how command remapping is handled: && !NILP (tem = Fget (definition, QCadvertised_binding))) { /* We have a list of advertised bindings. */ + /* FIXME: Not sure why we use false for shadow_lookup's remapping, + nor why we use `EQ' here but `Fequal' in the call further down. */ while (CONSP (tem)) if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition)) return XCAR (tem); @@ -2992,38 +2980,17 @@ key binding\n\ elt = XCAR (maps); elt_prefix = Fcar (elt); - sub_shadows = Qnil; - - for (tail = shadow; CONSP (tail); tail = XCDR (tail)) - { - Lisp_Object shmap; - - shmap = XCAR (tail); - - /* If the sequence by which we reach this keymap is zero-length, - then the shadow map for this keymap is just SHADOW. */ - if ((STRINGP (elt_prefix) && SCHARS (elt_prefix) == 0) - || (VECTORP (elt_prefix) && ASIZE (elt_prefix) == 0)) - ; - /* If the sequence by which we reach this keymap actually has - some elements, then the sequence's definition in SHADOW is - what we should use. */ - else - { - shmap = Flookup_key (shmap, Fcar (elt), Qt); - if (FIXNUMP (shmap)) - shmap = Qnil; - } - - /* If shmap is not nil and not a keymap, + sub_shadows = Flookup_key (shadow, elt_prefix, Qt); + if (FIXNATP (sub_shadows)) + sub_shadows = Qnil; + else if (!KEYMAPP (sub_shadows) + && !NILP (sub_shadows) + && !(CONSP (sub_shadows) + && KEYMAPP (XCAR (sub_shadows)))) + /* If elt_prefix is bound to something that's not a keymap, it completely shadows this map, so don't describe this map at all. */ - if (!NILP (shmap) && !KEYMAPP (shmap)) - goto skip; - - if (!NILP (shmap)) - sub_shadows = Fcons (shmap, sub_shadows); - } + goto skip; /* Maps we have already listed in this loop shadow this map. */ for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail)) From a1e615618dfef25c7fd14cbe1a16bdacca1148f4 Mon Sep 17 00:00:00 2001 From: Noam Postavsky Date: Wed, 29 Aug 2018 22:47:00 -0400 Subject: [PATCH 13/26] * test/lisp/calc/calc-tests.el (calc-imaginary-i): New test. --- test/lisp/calc/calc-tests.el | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index fbd5f0e3a1d..101786c30e3 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -86,6 +86,13 @@ An existing calc stack is reused, otherwise a new one is created." (math-read-expr "1m") "cm") '(* -100 (var cm var-cm))))) +(ert-deftest calc-imaginary-i () + "Test `math-imaginary-i' for non-special-const values." + (let ((var-i (calcFunc-polar (calcFunc-sqrt -1)))) + (should (math-imaginary-i))) + (let ((var-i (calcFunc-sqrt -1))) + (should (math-imaginary-i)))) + (ert-deftest test-calc-23889 () "Test for https://debbugs.gnu.org/23889 and 25652." (skip-unless (>= math-bignum-digit-length 9)) From 3d09d533d15eae2974f3858df43746cf6e8f897b Mon Sep 17 00:00:00 2001 From: Miciah Masters Date: Sun, 10 Dec 2017 19:56:48 -0500 Subject: [PATCH 14/26] rcirc: Document /reconnect as a built-in command (Bug#29656) The change "New command rcirc-cmd-reconnect" from 2014-04-09 (shipped in Emacs 25.1) added a /reconnect command to rcirc but did not document it and did not delete the example /reconnect command definition in the manual. * doc/misc/rcirc.texi (rcirc commands): Document the built-in /reconnect command. (Hacking and Tweaking): Delete example reconnect command. Copyright-paperwork-exempt: yes --- doc/misc/rcirc.texi | 60 +++++++++++++-------------------------------- 1 file changed, 17 insertions(+), 43 deletions(-) diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index 2437e020eee..0287054b1d2 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -88,7 +88,6 @@ Hacking and Tweaking * Scrolling conservatively:: * Changing the time stamp format:: * Defining a new command:: -* Reconnecting after you have lost the connection:: @end detailmenu @end menu @@ -401,6 +400,23 @@ This disconnects from the server and parts all channels. You can optionally provide a reason for quitting. When you kill the server buffer, you automatically quit the server and part all channels. (Also @code{/quit ZZZzzz...}.) + +@item /reconnect +@cindex /reconnect +@cindex reconnect +@cindex lost connection +@cindex disconnecting servers, reconnecting +This reconnects after you have lost the connection. + +If you're chatting from a laptop, then you might be familiar with this +problem: When your laptop falls asleep and wakes up later, your IRC +client doesn't realize that it has been disconnected. It takes several +minutes until the client decides that the connection has in fact been +lost. The simple solution is to use @kbd{M-x rcirc}. The problem is +that this opens an @emph{additional} connection, so you'll have two +copies of every channel buffer, one dead and one live. + +The real answer, therefore, is the @code{/reconnect} command. @end table @node Useful IRC commands @@ -787,7 +803,6 @@ Here are some examples of stuff you can do to configure @code{rcirc}. * Scrolling conservatively:: * Changing the time stamp format:: * Defining a new command:: -* Reconnecting after you have lost the connection:: @end menu @node Skipping /away messages using handlers @@ -888,47 +903,6 @@ because @code{defun-rcirc-command} is not yet available, and without (concat "I use " rcirc-id-string)))) @end smallexample -@node Reconnecting after you have lost the connection -@section Reconnecting after you have lost the connection -@cindex reconnecting -@cindex disconnecting servers, reconnecting - -If you're chatting from a laptop, then you might be familiar with this -problem: When your laptop falls asleep and wakes up later, your IRC -client doesn't realize that it has been disconnected. It takes several -minutes until the client decides that the connection has in fact been -lost. The simple solution is to use @kbd{M-x rcirc}. The problem is -that this opens an @emph{additional} connection, so you'll have two -copies of every channel buffer, one dead and one live. - -The real answer, therefore, is a @code{/reconnect} command: - -@smallexample -(with-eval-after-load 'rcirc - (defun-rcirc-command reconnect (arg) - "Reconnect the server process." - (interactive "i") - (unless process - (error "There's no process for this target")) - (let* ((server (car (process-contact process))) - (port (process-contact process :service)) - (nick (rcirc-nick process)) - channels query-buffers) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (eq process (rcirc-buffer-process)) - (remove-hook 'change-major-mode-hook - 'rcirc-change-major-mode-hook) - (if (rcirc-channel-p rcirc-target) - (setq channels (cons rcirc-target channels)) - (setq query-buffers (cons buf query-buffers)))))) - (delete-process process) - (rcirc-connect server port nick - rcirc-default-user-name - rcirc-default-full-name - channels)))) -@end smallexample - @node GNU Free Documentation License @appendix GNU Free Documentation License @include doclicense.texi From 42ed35c68b7c199aa797e655fdc3547c5c3087d2 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 30 Aug 2018 10:03:43 -0700 Subject: [PATCH 15/26] Pacify -Wdouble-promotion in ImageMagick code * src/image.c (imagemagick_load_image): Use double division, and eliminate a cast. This avoids a -Wdouble-promotion warning with GCC 7.3 on Ubuntu 18.04. --- src/image.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/image.c b/src/image.c index 69aeab5d657..24decbc0997 100644 --- a/src/image.c +++ b/src/image.c @@ -8824,7 +8824,8 @@ imagemagick_load_image (struct frame *f, struct image *img, #endif /* HAVE_MAGICKEXPORTIMAGEPIXELS */ { size_t image_height; - MagickRealType color_scale = 65535.0 / (MagickRealType) QuantumRange; + double quantum_range = QuantumRange; + MagickRealType color_scale = 65535.0 / quantum_range; #ifdef USE_CAIRO data = xmalloc (width * height * 4); color_scale /= 256; From 3cc42bb60099c32f64e57d2ee33c8321adba7942 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Thu, 30 Aug 2018 13:56:08 -0400 Subject: [PATCH 16/26] * configure.ac: Fix goofs in my recent ImageMagick change. --- configure.ac | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/configure.ac b/configure.ac index 85ac932688c..6f3d7338c35 100644 --- a/configure.ac +++ b/configure.ac @@ -2515,10 +2515,9 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" export PKG_CONFIG_PATH="$PKG_CONFIG_PATH$PATH_SEPARATOR`$BREW --prefix imagemagick@6 2>/dev/null`/lib/pkgconfig" fi - EMACS_CHECK_MODULES([IMAGEMAGICK7], [MagickWand >= 7]) - if test $HAVE_IMAGEMAGICK7 = yes; then + EMACS_CHECK_MODULES([IMAGEMAGICK], [MagickWand >= 7]) + if test $HAVE_IMAGEMAGICK = yes; then AC_DEFINE([HAVE_IMAGEMAGICK7], 1, [Define to 1 if using ImageMagick7.]) - HAVE_IMAGEMAGICK = yes else ## 6.3.5 is the earliest version known to work; see Bug#17339. ## 6.8.2 makes Emacs crash; see Bug#13867. @@ -2543,8 +2542,6 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" = "yes" || test "${HAVE_W32}" fi if test $HAVE_IMAGEMAGICK = yes; then AC_DEFINE([HAVE_IMAGEMAGICK], 1, [Define to 1 if using ImageMagick.]) - AC_DEFINE_UNQUOTED([IMAGEMAGICK_MAJOR], [$IMAGEMAGICK_MAJOR], - [ImageMagick major version number (from configure).]) else IMAGEMAGICK_CFLAGS= IMAGEMAGICK_LIBS= From 54b92132e1ec16565d59d6d9f8ff8910f38843b2 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 30 Aug 2018 21:29:04 +0200 Subject: [PATCH 17/26] Handle thread-signal towards the main thread (Bug#32502) * doc/lispref/threads.texi (Basic Thread Functions): * etc/NEWS: Document thread-signal towards the main thread. * lisp/emacs-lisp/thread.el: New package. * src/keyboard.c (read_char): Check for Qthread_event. (kbd_buffer_get_event, make_lispy_event): Handle THREAD_EVENT. (syms_of_keyboard): Declare Qthread_event. (keys_of_keyboard): Add thread-handle-event to special-event-map. * src/termhooks.h (enum event_kind): Add THREAD_EVENT. * src/thread.c: Include "keyboard.h". (poll_suppress_count) Don't declare extern. (Fthread_signal): Raise event if THREAD is the main thread. (Bug#32502) * test/src/thread-tests.el (thread): Require it. (threads-signal-main-thread): New test. --- doc/lispref/threads.texi | 10 ++-------- etc/NEWS | 4 ++++ lisp/emacs-lisp/thread.el | 42 +++++++++++++++++++++++++++++++++++++++ src/keyboard.c | 27 +++++++++++++++++++++++-- src/termhooks.h | 4 ++++ src/thread.c | 33 ++++++++++++++++++++++-------- test/src/thread-tests.el | 21 ++++++++++++++++++++ 7 files changed, 123 insertions(+), 18 deletions(-) create mode 100644 lisp/emacs-lisp/thread.el diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index 58a3a918efd..98301984114 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -88,14 +88,8 @@ If @var{thread} was blocked by a call to @code{mutex-lock}, @code{condition-wait}, or @code{thread-join}; @code{thread-signal} will unblock it. -Since signal handlers in Emacs are located in the main thread, a -signal must be propagated there in order to become visible. The -second @code{signal} call let the thread die: - -@example -(thread-signal main-thread 'error data) -(signal 'error data) -@end example +If @var{thread} is the main thread, the signal is not propagated +there. Instead, it is shown as message in the main thread. @end defun @defun thread-yield diff --git a/etc/NEWS b/etc/NEWS index 8a774d81c5b..d536faaa2d6 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -726,6 +726,10 @@ to signal the main thread, e.g., when they encounter an error. +++ *** 'thread-join' returns the result of the finished thread now. ++++ +*** 'thread-signal' does not propagate errors to the main thread. +Instead, error messages are just printed in the main thread. + --- ** thingatpt.el supports a new "thing" called 'uuid'. A symbol 'uuid' can be passed to thing-at-point and it returns the diff --git a/lisp/emacs-lisp/thread.el b/lisp/emacs-lisp/thread.el new file mode 100644 index 00000000000..02cf9b9e53f --- /dev/null +++ b/lisp/emacs-lisp/thread.el @@ -0,0 +1,42 @@ +;;; thread.el --- List active threads in a buffer -*- lexical-binding: t -*- + +;; Copyright (C) 2018 Free Software Foundation, Inc. + +;; Author: Gemini Lasswell +;; Maintainer: emacs-devel@gnu.org +;; Keywords: lisp, tools, maint + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +;;;###autoload +(defun thread-handle-event (event) + "Handle thread events, propagated by `thread-signal'. +An EVENT has the format + (thread-event THREAD ERROR-SYMBOL DATA)" + (interactive "e") + (if (and (consp event) + (eq (car event) 'thread-event) + (= (length event) 4)) + (let ((thread (cadr event)) + (err (cddr event))) + (message "Error %s: %S" thread err)))) + +(provide 'thread) +;;; thread.el ends here diff --git a/src/keyboard.c b/src/keyboard.c index 7fafb41fcc5..008d3b9d7c0 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -2827,6 +2827,9 @@ read_char (int commandflag, Lisp_Object map, #endif #ifdef USE_FILE_NOTIFY || EQ (XCAR (c), Qfile_notify) +#endif +#ifdef THREADS_ENABLED + || EQ (XCAR (c), Qthread_event) #endif || EQ (XCAR (c), Qconfig_changed_event)) && !end_time) @@ -3739,7 +3742,7 @@ kbd_buffer_get_event (KBOARD **kbp, } #endif /* subprocesses */ -#if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY +#if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED if (noninteractive /* In case we are running as a daemon, only do this before detaching from the terminal. */ @@ -3750,7 +3753,7 @@ kbd_buffer_get_event (KBOARD **kbp, *kbp = current_kboard; return obj; } -#endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY */ +#endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED */ /* Wait until there is input available. */ for (;;) @@ -3900,6 +3903,9 @@ kbd_buffer_get_event (KBOARD **kbp, #ifdef HAVE_DBUS case DBUS_EVENT: #endif +#ifdef THREADS_ENABLED + case THREAD_EVENT: +#endif #ifdef HAVE_XWIDGETS case XWIDGET_EVENT: #endif @@ -5983,6 +5989,13 @@ make_lispy_event (struct input_event *event) } #endif /* HAVE_DBUS */ +#ifdef THREADS_ENABLED + case THREAD_EVENT: + { + return Fcons (Qthread_event, event->arg); + } +#endif /* THREADS_ENABLED */ + #ifdef HAVE_XWIDGETS case XWIDGET_EVENT: { @@ -11078,6 +11091,10 @@ syms_of_keyboard (void) DEFSYM (Qdbus_event, "dbus-event"); #endif +#ifdef THREADS_ENABLED + DEFSYM (Qthread_event, "thread-event"); +#endif + #ifdef HAVE_XWIDGETS DEFSYM (Qxwidget_event, "xwidget-event"); #endif @@ -11929,6 +11946,12 @@ keys_of_keyboard (void) "dbus-handle-event"); #endif +#ifdef THREADS_ENABLED + /* Define a special event which is raised for thread signals. */ + initial_define_lispy_key (Vspecial_event_map, "thread-event", + "thread-handle-event"); +#endif + #ifdef USE_FILE_NOTIFY /* Define a special event which is raised for notification callback functions. */ diff --git a/src/termhooks.h b/src/termhooks.h index 160bd2f4803..8b5f648b43d 100644 --- a/src/termhooks.h +++ b/src/termhooks.h @@ -222,6 +222,10 @@ enum event_kind , DBUS_EVENT #endif +#ifdef THREADS_ENABLED + , THREAD_EVENT +#endif + , CONFIG_CHANGED_EVENT #ifdef HAVE_NTGUI diff --git a/src/thread.c b/src/thread.c index 1c73d938655..78cb2161993 100644 --- a/src/thread.c +++ b/src/thread.c @@ -25,6 +25,7 @@ along with GNU Emacs. If not, see . */ #include "process.h" #include "coding.h" #include "syssignal.h" +#include "keyboard.h" static struct thread_state main_thread; @@ -34,7 +35,6 @@ static struct thread_state *all_threads = &main_thread; static sys_mutex_t global_lock; -extern int poll_suppress_count; extern volatile int interrupt_input_blocked; @@ -863,7 +863,8 @@ DEFUN ("thread-signal", Fthread_signal, Sthread_signal, 3, 3, 0, This acts like `signal', but arranges for the signal to be raised in THREAD. If THREAD is the current thread, acts just like `signal'. This will interrupt a blocked call to `mutex-lock', `condition-wait', -or `thread-join' in the target thread. */) +or `thread-join' in the target thread. +If THREAD is the main thread, just the error message is shown. */) (Lisp_Object thread, Lisp_Object error_symbol, Lisp_Object data) { struct thread_state *tstate; @@ -874,13 +875,29 @@ or `thread-join' in the target thread. */) if (tstate == current_thread) Fsignal (error_symbol, data); - /* What to do if thread is already signaled? */ - /* What if error_symbol is Qnil? */ - tstate->error_symbol = error_symbol; - tstate->error_data = data; + if (main_thread_p (tstate)) + { + /* Construct an event. */ + struct input_event event; + EVENT_INIT (event); + event.kind = THREAD_EVENT; + event.frame_or_window = Qnil; + event.arg = list3 (Fcurrent_thread (), error_symbol, data); - if (tstate->wait_condvar) - flush_stack_call_func (thread_signal_callback, tstate); + /* Store it into the input event queue. */ + kbd_buffer_store_event (&event); + } + + else + { + /* What to do if thread is already signaled? */ + /* What if error_symbol is Qnil? */ + tstate->error_symbol = error_symbol; + tstate->error_data = data; + + if (tstate->wait_condvar) + flush_stack_call_func (thread_signal_callback, tstate); + } return Qnil; } diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 364f6d61f05..cc1dff8a281 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -19,6 +19,8 @@ ;;; Code: +(require 'thread) + ;; Declare the functions in case Emacs has been configured --without-threads. (declare-function all-threads "thread.c" ()) (declare-function condition-mutex "thread.c" (cond)) @@ -320,6 +322,25 @@ (should-not (thread-alive-p thread)) (should (equal (thread-last-error) '(error))))) +(ert-deftest threads-signal-main-thread () + "Test signaling the main thread." + (skip-unless (featurep 'threads)) + ;; We cannot use `ert-with-message-capture', because threads do not + ;; know let-bound variables. + (with-current-buffer "*Messages*" + (let (buffer-read-only) + (erase-buffer)) + (let ((thread + (make-thread #'(lambda () (thread-signal main-thread 'error nil))))) + (while (thread-alive-p thread) + (thread-yield)) + (read-event nil nil 0.1) + ;; No error has been raised, which is part of the test. + (should + (string-match + (format-message "Error %s: (error nil)" thread) + (buffer-string )))))) + (defvar threads-condvar nil) (defun threads-test-condvar-wait () From 6d6f45e21830a57b4a12af0f89913752a137a653 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 30 Aug 2018 14:28:19 -0700 Subject: [PATCH 18/26] Fix off-by-1 typo in recent bignum changes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Problem reported by Yuri D’Elia in: https://lists.gnu.org/r/emacs-devel/2018-08/msg00977.html and crucial clue provided by Michael Heerdegen in: https://lists.gnu.org/r/emacs-devel/2018-08/msg01043.html * src/font.c (font_unparse_xlfd): Fix off-by-1 typo. --- src/font.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/font.c b/src/font.c index 4a63700f790..e2414582f67 100644 --- a/src/font.c +++ b/src/font.c @@ -1290,7 +1290,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char *name, int nbytes) if (INTEGERP (val)) { intmax_t v = FIXNUMP (val) ? XFIXNUM (val) : bignum_to_intmax (val); - if (! (0 <= v && v <= TYPE_MAXIMUM (uprintmax_t))) + if (! (0 < v && v <= TYPE_MAXIMUM (uprintmax_t))) v = pixel_size; if (v > 0) { From eb5588db69b3134832f79447dfba59333be41e8b Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 31 Aug 2018 01:15:56 +0300 Subject: [PATCH 19/26] * lisp/gnus/mm-view.el (mm-display-inline-fontify): Carry diff-mode overlays to inline MIME attachments from the temp buffer along with text properties. (Bug#32474) --- lisp/gnus/mm-view.el | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 50a927bce23..15eac11fb9e 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -452,7 +452,7 @@ "Insert HANDLE inline fontifying with MODE. If MODE is not set, try to find mode automatically." (let ((charset (mail-content-type-get (mm-handle-type handle) 'charset)) - text coding-system) + text coding-system ovs) (unless (eq charset 'gnus-decoded) (mm-with-unibyte-buffer (mm-insert-part handle) @@ -498,10 +498,18 @@ If MODE is not set, try to find mode automatically." (eq major-mode 'fundamental-mode)) (font-lock-ensure)))) (setq text (buffer-string)) + (when (eq mode 'diff-mode) + (setq ovs (mapcar (lambda (ov) (list ov (overlay-start ov) + (overlay-end ov))) + (overlays-in (point-min) (point-max))))) ;; Set buffer unmodified to avoid confirmation when killing the ;; buffer. (set-buffer-modified-p nil)) - (mm-insert-inline handle text))) + (let ((b (1- (point)))) + (mm-insert-inline handle text) + (dolist (ov ovs) + (move-overlay (nth 0 ov) (+ (nth 1 ov) b) + (+ (nth 2 ov) b) (current-buffer)))))) ;; Shouldn't these functions check whether the user even wants to use ;; font-lock? Also, it would be nice to change for the size of the From 15006cf1dd9ec873c4b1cad1ba1bacf0a5b6229d Mon Sep 17 00:00:00 2001 From: Juri Linkov Date: Fri, 31 Aug 2018 01:20:14 +0300 Subject: [PATCH 20/26] * lisp/vc/vc.el (vc-log-internal-common): Reuse the buffer object. (Bug#32475) --- lisp/vc/vc.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index b2bedfae939..487594b2d54 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2268,11 +2268,11 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." setup-buttons-func goto-location-func rev-buff-func) - (let (retval) - (with-current-buffer (get-buffer-create buffer-name) + (let (retval (buffer (get-buffer-create buffer-name))) + (with-current-buffer buffer (set (make-local-variable 'vc-log-view-type) type)) (setq retval (funcall backend-func backend buffer-name type files)) - (with-current-buffer (get-buffer buffer-name) + (with-current-buffer buffer (let ((inhibit-read-only t)) ;; log-view-mode used to be called with inhibit-read-only bound ;; to t, so let's keep doing it, just in case. @@ -2283,7 +2283,7 @@ earlier revisions. Show up to LIMIT entries (non-nil means unlimited)." rev-buff-func))) ;; Display after setting up major-mode, so display-buffer-alist can know ;; the major-mode. - (pop-to-buffer buffer-name) + (pop-to-buffer buffer) (vc-run-delayed (let ((inhibit-read-only t)) (funcall setup-buttons-func backend files retval) From 7c0675af3c9aa7971c37aa9e7afdceae6bfea767 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 30 Aug 2018 18:10:18 -0700 Subject: [PATCH 21/26] Fix bignum FIXME in emacs-module.c * src/emacs-module.c: Do not include bignum.h; no longer needed. (module_extract_integer): Use bignum_to_intmax to avoid incorrectly signaling overflow on platforms where intmax_t is wider than long int. --- src/emacs-module.c | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/emacs-module.c b/src/emacs-module.c index cf92b0fdb51..2ba5540d9a1 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -27,7 +27,6 @@ along with GNU Emacs. If not, see . */ #include #include "lisp.h" -#include "bignum.h" #include "dynlib.h" #include "coding.h" #include "keyboard.h" @@ -522,11 +521,10 @@ module_extract_integer (emacs_env *env, emacs_value n) CHECK_INTEGER (l); if (BIGNUMP (l)) { - /* FIXME: This can incorrectly signal overflow on platforms - where long is narrower than intmax_t. */ - if (!mpz_fits_slong_p (XBIGNUM (l)->value)) + intmax_t i = bignum_to_intmax (l); + if (i == 0) xsignal1 (Qoverflow_error, l); - return mpz_get_si (XBIGNUM (l)->value); + return i; } return XFIXNUM (l); } From 76978462bbb55eb4b5cfe4d70856e18ed1e21076 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 31 Aug 2018 09:04:13 +0200 Subject: [PATCH 22/26] Construct a thread_event only if THREADS_ENABLED * src/thread.c (Fthread_signal): Construct a thread_event only if THREADS_ENABLED. --- src/thread.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/thread.c b/src/thread.c index 78cb2161993..081569f8a38 100644 --- a/src/thread.c +++ b/src/thread.c @@ -875,6 +875,7 @@ If THREAD is the main thread, just the error message is shown. */) if (tstate == current_thread) Fsignal (error_symbol, data); +#ifdef THREADS_ENABLED if (main_thread_p (tstate)) { /* Construct an event. */ @@ -889,6 +890,7 @@ If THREAD is the main thread, just the error message is shown. */) } else +#endif { /* What to do if thread is already signaled? */ /* What if error_symbol is Qnil? */ From a451c6ec12b7b024f347364becb10c49807513ed Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 31 Aug 2018 00:22:15 -0700 Subject: [PATCH 23/26] * src/alloc.c (sweep_vectors): Simplify. --- src/alloc.c | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 350b668ec61..1eab82d1c2b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -3254,8 +3254,7 @@ sweep_vectors (void) for (block = vector_blocks; block; block = *bprev) { - bool free_this_block = 0; - ptrdiff_t nbytes; + bool free_this_block = false; for (vector = (struct Lisp_Vector *) block->data; VECTOR_IN_BLOCK (vector, block); vector = next) @@ -3264,31 +3263,26 @@ sweep_vectors (void) { VECTOR_UNMARK (vector); total_vectors++; - nbytes = vector_nbytes (vector); + ptrdiff_t nbytes = vector_nbytes (vector); total_vector_slots += nbytes / word_size; next = ADVANCE (vector, nbytes); } else { - ptrdiff_t total_bytes; - - cleanup_vector (vector); - nbytes = vector_nbytes (vector); - total_bytes = nbytes; - next = ADVANCE (vector, nbytes); + ptrdiff_t total_bytes = 0; /* While NEXT is not marked, try to coalesce with VECTOR, thus making VECTOR of the largest possible size. */ - while (VECTOR_IN_BLOCK (next, block)) + next = vector; + do { - if (VECTOR_MARKED_P (next)) - break; cleanup_vector (next); - nbytes = vector_nbytes (next); + ptrdiff_t nbytes = vector_nbytes (next); total_bytes += nbytes; next = ADVANCE (next, nbytes); } + while (VECTOR_IN_BLOCK (next, block) && !VECTOR_MARKED_P (next)); eassert (total_bytes % roundup_size == 0); @@ -3296,7 +3290,7 @@ sweep_vectors (void) && !VECTOR_IN_BLOCK (next, block)) /* This block should be freed because all of its space was coalesced into the only free vector. */ - free_this_block = 1; + free_this_block = true; else setup_on_free_list (vector, total_bytes); } From db2fed3bdfb351c3283e481829ce687931d27a3d Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 31 Aug 2018 00:25:07 -0700 Subject: [PATCH 24/26] Several fixes for formatting bignums * src/bignum.c: Include stdlib.h, for abs. (bignum_bufsize, bignum_to_c_string): New functions. * src/bignum.c (bignum_to_string): * src/print.c (print_vectorlike): Use them. * src/editfns.c (styled_format): Instead of having a separate buffer for sprintf (which does not work for bignums), just append to the main buffer. When formatting bignums, add support for the standard integer flags -, #, 0, + and space. Fix some comments. Capitalize properly when formatting bignums with %X. Use functions like c_isdigit rather than reinventing the wheel. Simplify computation of excess precision. * src/print.c: Do not include bignum.h; no longer needed. (print_vectorlike): Avoid recalculating string length. * test/src/editfns-tests.el (format-bignum): Test some of the above fixes. --- src/bignum.c | 37 +++- src/editfns.c | 369 +++++++++++++++++++++----------------- src/lisp.h | 5 +- src/print.c | 9 +- test/src/editfns-tests.el | 17 +- 5 files changed, 253 insertions(+), 184 deletions(-) diff --git a/src/bignum.c b/src/bignum.c index 5dbfdb9319a..b18ceccb59d 100644 --- a/src/bignum.c +++ b/src/bignum.c @@ -23,6 +23,8 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" +#include + /* Return the value of the Lisp bignum N, as a double. */ double bignum_to_double (Lisp_Object n) @@ -223,18 +225,39 @@ bignum_to_uintmax (Lisp_Object x) return v; } -/* Convert NUM to a base-BASE Lisp string. */ +/* Yield an upper bound on the buffer size needed to contain a C + string representing the bignum NUM in base BASE. This includes any + preceding '-' and the terminating null. */ +ptrdiff_t +bignum_bufsize (Lisp_Object num, int base) +{ + return mpz_sizeinbase (XBIGNUM (num)->value, base) + 2; +} + +/* Store into BUF (of size SIZE) the value of NUM as a base-BASE string. + If BASE is negative, use upper-case digits in base -BASE. + Return the string's length. + SIZE must equal bignum_bufsize (NUM, abs (BASE)). */ +ptrdiff_t +bignum_to_c_string (char *buf, ptrdiff_t size, Lisp_Object num, int base) +{ + eassert (bignum_bufsize (num, abs (base)) == size); + mpz_get_str (buf, base, XBIGNUM (num)->value); + ptrdiff_t n = size - 2; + return !buf[n - 1] ? n - 1 : n + !!buf[n]; +} + +/* Convert NUM to a base-BASE Lisp string. + If BASE is negative, use upper-case digits in base -BASE. */ Lisp_Object bignum_to_string (Lisp_Object num, int base) { - ptrdiff_t n = mpz_sizeinbase (XBIGNUM (num)->value, base) - 1; + ptrdiff_t size = bignum_bufsize (num, abs (base)); USE_SAFE_ALLOCA; - char *str = SAFE_ALLOCA (n + 3); - mpz_get_str (str, base, XBIGNUM (num)->value); - while (str[n]) - n++; - Lisp_Object result = make_unibyte_string (str, n); + char *str = SAFE_ALLOCA (size); + ptrdiff_t len = bignum_to_c_string (str, size, num, base); + Lisp_Object result = make_unibyte_string (str, len); SAFE_FREE (); return result; } diff --git a/src/editfns.c b/src/editfns.c index b4c597feda1..3b1c21a1781 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -4232,8 +4232,26 @@ usage: (format-message STRING &rest OBJECTS) */) static Lisp_Object styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) { + enum + { + /* Maximum precision for a %f conversion such that the trailing + output digit might be nonzero. Any precision larger than this + will not yield useful information. */ + USEFUL_PRECISION_MAX = ((1 - LDBL_MIN_EXP) + * (FLT_RADIX == 2 || FLT_RADIX == 10 ? 1 + : FLT_RADIX == 16 ? 4 + : -1)), + + /* Maximum number of bytes (including terminating null) generated + by any format, if precision is no more than USEFUL_PRECISION_MAX. + On all practical hosts, %Lf is the worst case. */ + SPRINTF_BUFSIZE = (sizeof "-." + (LDBL_MAX_10_EXP + 1) + + USEFUL_PRECISION_MAX) + }; + verify (USEFUL_PRECISION_MAX > 0); + ptrdiff_t n; /* The number of the next arg to substitute. */ - char initial_buffer[4000]; + char initial_buffer[1000 + SPRINTF_BUFSIZE]; char *buf = initial_buffer; ptrdiff_t bufsize = sizeof initial_buffer; ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1; @@ -4338,8 +4356,14 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) char const *convsrc = format; unsigned char format_char = *format++; - /* Bytes needed to represent the output of this conversion. */ + /* Number of bytes to be preallocated for the next directive's + output. At the end of each iteration this is at least + CONVBYTES_ROOM, and is greater if the current directive + output was so large that it will be retried after buffer + reallocation. */ ptrdiff_t convbytes = 1; + enum { CONVBYTES_ROOM = SPRINTF_BUFSIZE - 1 }; + eassert (p <= buf + bufsize - SPRINTF_BUFSIZE); if (format_char == '%') { @@ -4473,23 +4497,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) conversion = 's'; zero_flag = false; } - else if ((conversion == 'd' || conversion == 'i' - || conversion == 'o' || conversion == 'x' - || conversion == 'X') - && BIGNUMP (arg)) - { - int base = 10; - - if (conversion == 'o') - base = 8; - else if (conversion == 'x') - base = 16; - else if (conversion == 'X') - base = -16; - - arg = bignum_to_string (arg, base); - conversion = 's'; - } if (SYMBOLP (arg)) { @@ -4592,7 +4599,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) spec->intervals = arg_intervals = true; new_result = true; - continue; + convbytes = CONVBYTES_ROOM; } } else if (! (conversion == 'c' || conversion == 'd' @@ -4606,28 +4613,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) error ("Format specifier doesn't match argument type"); else { - enum - { - /* Maximum precision for a %f conversion such that the - trailing output digit might be nonzero. Any precision - larger than this will not yield useful information. */ - USEFUL_PRECISION_MAX = - ((1 - LDBL_MIN_EXP) - * (FLT_RADIX == 2 || FLT_RADIX == 10 ? 1 - : FLT_RADIX == 16 ? 4 - : -1)), - - /* Maximum number of bytes generated by any format, if - precision is no more than USEFUL_PRECISION_MAX. - On all practical hosts, %f is the worst case. */ - SPRINTF_BUFSIZE = - sizeof "-." + (LDBL_MAX_10_EXP + 1) + USEFUL_PRECISION_MAX, - - /* Length of pM (that is, of pMd without the - trailing "d"). */ - pMlen = sizeof pMd - 2 - }; - verify (USEFUL_PRECISION_MAX > 0); + /* Length of pM (that is, of pMd without the trailing "d"). */ + enum { pMlen = sizeof pMd - 2 }; /* Avoid undefined behavior in underlying sprintf. */ if (conversion == 'd' || conversion == 'i') @@ -4660,18 +4647,24 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) if (precision_given) prec = min (precision, USEFUL_PRECISION_MAX); - /* Use sprintf to format this number into sprintf_buf. Omit - padding and excess precision, though, because sprintf limits - output length to INT_MAX. + /* Characters to be inserted after spaces and before + leading zeros. This can occur with bignums, since + string_to_bignum does only leading '-'. */ + char prefix[sizeof "-0x" - 1]; + int prefixlen = 0; - There are four types of conversion: double, unsigned + /* Use sprintf or bignum_to_string to format this number. Omit + padding and excess precision, though, because sprintf limits + output length to INT_MAX and bignum_to_string doesn't + do padding or precision. + + Use five sprintf conversions: double, long double, unsigned char (passed as int), wide signed int, and wide unsigned int. Treat them separately because the sprintf ABI is sensitive to which type is passed. Be careful about integer overflow, NaNs, infinities, and conversions; for example, the min and max macros are not suitable here. */ - char sprintf_buf[SPRINTF_BUFSIZE]; ptrdiff_t sprintf_bytes; if (float_conversion) { @@ -4729,26 +4722,43 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) f[-1] = 'L'; *f++ = conversion; *f = '\0'; - sprintf_bytes = sprintf (sprintf_buf, convspec, prec, - ldarg); + sprintf_bytes = sprintf (p, convspec, prec, ldarg); } else - sprintf_bytes = sprintf (sprintf_buf, convspec, prec, - darg); + sprintf_bytes = sprintf (p, convspec, prec, darg); } else if (conversion == 'c') { /* Don't use sprintf here, as it might mishandle prec. */ - sprintf_buf[0] = XFIXNUM (arg); + p[0] = XFIXNUM (arg); + p[1] = '\0'; sprintf_bytes = prec != 0; - sprintf_buf[sprintf_bytes] = '\0'; + } + else if (BIGNUMP (arg)) + { + int base = ((conversion == 'd' || conversion == 'i') ? 10 + : conversion == 'o' ? 8 : 16); + sprintf_bytes = bignum_bufsize (arg, base); + if (sprintf_bytes <= buf + bufsize - p) + { + int signedbase = conversion == 'X' ? -base : base; + sprintf_bytes = bignum_to_c_string (p, sprintf_bytes, + arg, signedbase); + bool negative = p[0] == '-'; + prec = min (precision, sprintf_bytes - prefixlen); + prefix[prefixlen] = plus_flag ? '+' : ' '; + prefixlen += (plus_flag | space_flag) & !negative; + prefix[prefixlen] = '0'; + prefix[prefixlen + 1] = conversion; + prefixlen += sharp_flag && base == 16 ? 2 : 0; + } } else if (conversion == 'd' || conversion == 'i') { if (FIXNUMP (arg)) { printmax_t x = XFIXNUM (arg); - sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x); + sprintf_bytes = sprintf (p, convspec, prec, x); } else { @@ -4760,9 +4770,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) x = trunc (x); x = x ? x : 0; - sprintf_bytes = sprintf (sprintf_buf, convspec, 0, x); - char c0 = sprintf_buf[0]; - bool signedp = ! ('0' <= c0 && c0 <= '9'); + sprintf_bytes = sprintf (p, convspec, 0, x); + bool signedp = ! c_isdigit (p[0]); prec = min (precision, sprintf_bytes - signedp); } } @@ -4793,10 +4802,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) x = d; negative = false; } - sprintf_buf[0] = negative ? '-' : plus_flag ? '+' : ' '; + p[0] = negative ? '-' : plus_flag ? '+' : ' '; bool signedp = negative | plus_flag | space_flag; - sprintf_bytes = sprintf (sprintf_buf + signedp, - convspec, prec, x); + sprintf_bytes = sprintf (p + signedp, convspec, prec, x); sprintf_bytes += signedp; } @@ -4804,112 +4812,126 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) padding and excess precision. Deal with excess precision first. This happens when the format specifies ridiculously large precision, or when %d or %i formats a float that would - ordinarily need fewer digits than a specified precision. */ + ordinarily need fewer digits than a specified precision, + or when a bignum is formatted using an integer format + with enough precision. */ ptrdiff_t excess_precision = precision_given ? precision - prec : 0; - ptrdiff_t leading_zeros = 0, trailing_zeros = 0; - if (excess_precision) + ptrdiff_t trailing_zeros = 0; + if (excess_precision != 0 && float_conversion) { - if (float_conversion) - { - if ((conversion == 'g' && ! sharp_flag) - || ! ('0' <= sprintf_buf[sprintf_bytes - 1] - && sprintf_buf[sprintf_bytes - 1] <= '9')) - excess_precision = 0; - else - { - if (conversion == 'g') - { - char *dot = strchr (sprintf_buf, '.'); - if (!dot) - excess_precision = 0; - } - } - trailing_zeros = excess_precision; - } - else - leading_zeros = excess_precision; + if (! c_isdigit (p[sprintf_bytes - 1]) + || (conversion == 'g' + && ! (sharp_flag && strchr (p, '.')))) + excess_precision = 0; + trailing_zeros = excess_precision; } + ptrdiff_t leading_zeros = excess_precision - trailing_zeros; /* Compute the total bytes needed for this item, including excess precision and padding. */ ptrdiff_t numwidth; - if (INT_ADD_WRAPV (sprintf_bytes, excess_precision, &numwidth)) + if (INT_ADD_WRAPV (prefixlen + sprintf_bytes, excess_precision, + &numwidth)) numwidth = PTRDIFF_MAX; ptrdiff_t padding = numwidth < field_width ? field_width - numwidth : 0; - if (max_bufsize - sprintf_bytes <= excess_precision + if (max_bufsize - (prefixlen + sprintf_bytes) <= excess_precision || max_bufsize - padding <= numwidth) string_overflow (); convbytes = numwidth + padding; if (convbytes <= buf + bufsize - p) { - /* Copy the formatted item from sprintf_buf into buf, - inserting padding and excess-precision zeros. */ - - char *src = sprintf_buf; - char src0 = src[0]; - int exponent_bytes = 0; - bool signedp = src0 == '-' || src0 == '+' || src0 == ' '; - int prefix_bytes = (signedp - + ((src[signedp] == '0' - && (src[signedp + 1] == 'x' - || src[signedp + 1] == 'X')) - ? 2 : 0)); - if (zero_flag) + bool signedp = p[0] == '-' || p[0] == '+' || p[0] == ' '; + int beglen = (signedp + + ((p[signedp] == '0' + && (p[signedp + 1] == 'x' + || p[signedp + 1] == 'X')) + ? 2 : 0)); + eassert (prefixlen == 0 || beglen == 0 + || (beglen == 1 && p[0] == '-' + && ! (prefix[0] == '-' || prefix[0] == '+' + || prefix[0] == ' '))); + if (zero_flag && 0 <= char_hexdigit (p[beglen])) { - unsigned char after_prefix = src[prefix_bytes]; - if (0 <= char_hexdigit (after_prefix)) - { - leading_zeros += padding; - padding = 0; - } + leading_zeros += padding; + padding = 0; + } + if (leading_zeros == 0 && sharp_flag && conversion == 'o' + && p[beglen] != '0') + { + leading_zeros++; + padding -= padding != 0; } - if (excess_precision + int endlen = 0; + if (trailing_zeros && (conversion == 'e' || conversion == 'g')) { - char *e = strchr (src, 'e'); + char *e = strchr (p, 'e'); if (e) - exponent_bytes = src + sprintf_bytes - e; + endlen = p + sprintf_bytes - e; } + ptrdiff_t midlen = sprintf_bytes - beglen - endlen; + ptrdiff_t leading_padding = minus_flag ? 0 : padding; + ptrdiff_t trailing_padding = padding - leading_padding; + + /* Insert padding and excess-precision zeros. The output + contains the following components, in left-to-right order: + + LEADING_PADDING spaces. + BEGLEN bytes taken from the start of sprintf output. + PREFIXLEN bytes taken from the start of the prefix array. + LEADING_ZEROS zeros. + MIDLEN bytes taken from the middle of sprintf output. + TRAILING_ZEROS zeros. + ENDLEN bytes taken from the end of sprintf output. + TRAILING_PADDING spaces. + + The sprintf output is taken from the buffer starting at + P and continuing for SPRINTF_BYTES bytes. */ + + ptrdiff_t incr + = (padding + leading_zeros + prefixlen + + sprintf_bytes + trailing_zeros); + + /* Optimize for the typical case with padding or zeros. */ + if (incr != sprintf_bytes) + { + /* Move data to make room to insert spaces and '0's. + As this may entail overlapping moves, process + the output right-to-left and use memmove. + With any luck this code is rarely executed. */ + char *src = p + sprintf_bytes; + char *dst = p + incr; + dst -= trailing_padding; + memset (dst, ' ', trailing_padding); + src -= endlen; + dst -= endlen; + memmove (dst, src, endlen); + dst -= trailing_zeros; + memset (dst, '0', trailing_zeros); + src -= midlen; + dst -= midlen; + memmove (dst, src, midlen); + dst -= leading_zeros; + memset (dst, '0', leading_zeros); + dst -= prefixlen; + memcpy (dst, prefix, prefixlen); + src -= beglen; + dst -= beglen; + memmove (dst, src, beglen); + dst -= leading_padding; + memset (dst, ' ', leading_padding); + } + + p += incr; spec->start = nchars; - if (! minus_flag) - { - memset (p, ' ', padding); - p += padding; - nchars += padding; - } - - memcpy (p, src, prefix_bytes); - p += prefix_bytes; - src += prefix_bytes; - memset (p, '0', leading_zeros); - p += leading_zeros; - int significand_bytes - = sprintf_bytes - prefix_bytes - exponent_bytes; - memcpy (p, src, significand_bytes); - p += significand_bytes; - src += significand_bytes; - memset (p, '0', trailing_zeros); - p += trailing_zeros; - memcpy (p, src, exponent_bytes); - p += exponent_bytes; - - nchars += leading_zeros + sprintf_bytes + trailing_zeros; - - if (minus_flag) - { - memset (p, ' ', padding); - p += padding; - nchars += padding; - } - spec->end = nchars; - + spec->end = nchars += incr; new_result = true; - continue; + convbytes = CONVBYTES_ROOM; } } } @@ -4962,42 +4984,51 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) } copy_char: - if (convbytes <= buf + bufsize - p) - { - memcpy (p, convsrc, convbytes); - p += convbytes; - nchars++; - continue; - } + memcpy (p, convsrc, convbytes); + p += convbytes; + nchars++; + convbytes = CONVBYTES_ROOM; } - /* There wasn't enough room to store this conversion or single - character. CONVBYTES says how much room is needed. Allocate - enough room (and then some) and do it again. */ - ptrdiff_t used = p - buf; - if (max_bufsize - used < convbytes) + ptrdiff_t buflen_needed; + if (INT_ADD_WRAPV (used, convbytes, &buflen_needed)) string_overflow (); - bufsize = used + convbytes; - bufsize = bufsize < max_bufsize / 2 ? bufsize * 2 : max_bufsize; - - if (buf == initial_buffer) + if (bufsize <= buflen_needed) { - buf = xmalloc (bufsize); - buf_save_value_index = SPECPDL_INDEX (); - record_unwind_protect_ptr (xfree, buf); - memcpy (buf, initial_buffer, used); - } - else - { - buf = xrealloc (buf, bufsize); - set_unwind_protect_ptr (buf_save_value_index, xfree, buf); - } + if (max_bufsize <= buflen_needed) + string_overflow (); - p = buf + used; - format = format0; - n = n0; - ispec = ispec0; + /* Either there wasn't enough room to store this conversion, + or there won't be enough room to do a sprintf the next + time through the loop. Allocate enough room (and then some). */ + + bufsize = (buflen_needed <= max_bufsize / 2 + ? buflen_needed * 2 : max_bufsize); + + if (buf == initial_buffer) + { + buf = xmalloc (bufsize); + buf_save_value_index = SPECPDL_INDEX (); + record_unwind_protect_ptr (xfree, buf); + memcpy (buf, initial_buffer, used); + } + else + { + buf = xrealloc (buf, bufsize); + set_unwind_protect_ptr (buf_save_value_index, xfree, buf); + } + + p = buf + used; + if (convbytes != CONVBYTES_ROOM) + { + /* There wasn't enough room for this conversion; do it over. */ + eassert (CONVBYTES_ROOM < convbytes); + format = format0; + n = n0; + ispec = ispec0; + } + } } if (bufsize < p - buf) diff --git a/src/lisp.h b/src/lisp.h index c5b51ba3b35..36ca32c3c05 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -3278,9 +3278,12 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val) XSUB_CHAR_TABLE (table)->contents[idx] = val; } -/* Defined in bignum.c. */ +/* Defined in bignum.c. This part of bignum.c's API does not require + the caller to access bignum internals; see bignum.h for that. */ extern intmax_t bignum_to_intmax (Lisp_Object); extern uintmax_t bignum_to_uintmax (Lisp_Object); +extern ptrdiff_t bignum_bufsize (Lisp_Object, int); +extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int); extern Lisp_Object bignum_to_string (Lisp_Object, int); extern Lisp_Object make_bignum_str (char const *, int); extern Lisp_Object double_to_bignum (double); diff --git a/src/print.c b/src/print.c index 49d9e38e7d3..c0c90bc7e9a 100644 --- a/src/print.c +++ b/src/print.c @@ -23,7 +23,6 @@ along with GNU Emacs. If not, see . */ #include "sysstdio.h" #include "lisp.h" -#include "bignum.h" #include "character.h" #include "coding.h" #include "buffer.h" @@ -1370,11 +1369,11 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, { case PVEC_BIGNUM: { + ptrdiff_t size = bignum_bufsize (obj, 10); USE_SAFE_ALLOCA; - char *str = SAFE_ALLOCA (mpz_sizeinbase (XBIGNUM (obj)->value, 10) - + 2); - mpz_get_str (str, 10, XBIGNUM (obj)->value); - print_c_string (str, printcharfun); + char *str = SAFE_ALLOCA (size); + ptrdiff_t len = bignum_to_c_string (str, size, obj, 10); + strout (str, len, len, printcharfun); SAFE_FREE (); } break; diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 964ff088360..487f3aaa666 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -381,10 +381,23 @@ (let* ((s1 "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF") (v1 (read (concat "#x" s1))) (s2 "99999999999999999999999999999999") - (v2 (read s2))) + (v2 (read s2)) + (v3 #x-3ffffffffffffffe000000000000000)) (should (> v1 most-positive-fixnum)) (should (equal (format "%X" v1) s1)) (should (> v2 most-positive-fixnum)) - (should (equal (format "%d" v2) s2)))) + (should (equal (format "%d" v2) s2)) + (should (equal (format "%d" v3) "-5316911983139663489309385231907684352")) + (should (equal (format "%+d" v3) "-5316911983139663489309385231907684352")) + (should (equal (format "%+d" (- v3)) + "+5316911983139663489309385231907684352")) + (should (equal (format "% d" (- v3)) + " 5316911983139663489309385231907684352")) + (should (equal (format "%o" v3) + "-37777777777777777777600000000000000000000")) + (should (equal (format "%#50.40x" v3) + " -0x000000003ffffffffffffffe000000000000000")) + (should (equal (format "%-#50.40x" v3) + "-0x000000003ffffffffffffffe000000000000000 ")))) ;;; editfns-tests.el ends here From ac7936cb8f4d4d6706535bfcea0d97741c2ca15f Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 31 Aug 2018 10:47:03 +0200 Subject: [PATCH 25/26] Rename thread-alive-p to thread-live-p * doc/lispref/threads.texi (Basic Thread Functions): Use thread-live-p. * etc/NEWS: 'thread-alive-p' has been renamed to 'thread-live-p'. * src/thread.c (thread_live_p): Rename from thread_alive_p. Adapt all callees. (Fthread_live_p): Rename from Fthread_alive_p. (syms_of_threads): Make thread-alive-p an alias of thread-live-p. * test/src/thread-tests.el (all): Replace `thread-alive-p' by `thread-live-p'. (threads-live): Rename from `threads-alive'. --- doc/lispref/threads.texi | 2 +- etc/NEWS | 5 +++++ src/thread.c | 17 ++++++++++------- test/src/thread-tests.el | 16 ++++++++-------- 4 files changed, 24 insertions(+), 16 deletions(-) diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index f05af496188..ddeb2e923fc 100644 --- a/doc/lispref/threads.texi +++ b/doc/lispref/threads.texi @@ -97,7 +97,7 @@ Yield execution to the next runnable thread. Return the name of @var{thread}, as specified to @code{make-thread}. @end defun -@defun thread-alive-p thread +@defun thread-live-p thread Return @code{t} if @var{thread} is alive, or @code{nil} if it is not. A thread is alive as long as its function is still executing. @end defun diff --git a/etc/NEWS b/etc/NEWS index ffea247dd5a..f575d4dd005 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -112,6 +112,11 @@ option 'vc-hg-symbolic-revision-styles' to the value '("{rev}")'. Existing files "~/.emacs.d/shadows" and "~/.emacs.d/shadow_todo" must be removed prior using the changed 'shadow-*' commands. ++++ +** 'thread-alive-p' has been renamed to 'thread-live-p'. +The old name is an alias of the new name. Future Emacs version will +obsolete it. + * Lisp Changes in Emacs 26.2 diff --git a/src/thread.c b/src/thread.c index 04c2808e5c4..9b450ee0a45 100644 --- a/src/thread.c +++ b/src/thread.c @@ -41,7 +41,7 @@ extern volatile int interrupt_input_blocked; /* m_specpdl is set when the thread is created and cleared when the thread dies. */ -#define thread_alive_p(STATE) ((STATE)->m_specpdl != NULL) +#define thread_live_p(STATE) ((STATE)->m_specpdl != NULL) @@ -884,7 +884,7 @@ or `thread-join' in the target thread. */) return Qnil; } -DEFUN ("thread-alive-p", Fthread_alive_p, Sthread_alive_p, 1, 1, 0, +DEFUN ("thread-live-p", Fthread_live_p, Sthread_live_p, 1, 1, 0, doc: /* Return t if THREAD is alive, or nil if it has exited. */) (Lisp_Object thread) { @@ -893,7 +893,7 @@ DEFUN ("thread-alive-p", Fthread_alive_p, Sthread_alive_p, 1, 1, 0, CHECK_THREAD (thread); tstate = XTHREAD (thread); - return thread_alive_p (tstate) ? Qt : Qnil; + return thread_live_p (tstate) ? Qt : Qnil; } DEFUN ("thread--blocker", Fthread_blocker, Sthread_blocker, 1, 1, 0, @@ -923,7 +923,7 @@ thread_join_callback (void *arg) XSETTHREAD (thread, tstate); self->event_object = thread; self->wait_condvar = &tstate->thread_condvar; - while (thread_alive_p (tstate) && NILP (self->error_symbol)) + while (thread_live_p (tstate) && NILP (self->error_symbol)) sys_cond_wait (self->wait_condvar, &global_lock); self->wait_condvar = NULL; @@ -946,7 +946,7 @@ It is an error for a thread to try to join itself. */) if (tstate == current_thread) error ("Cannot join current thread"); - if (thread_alive_p (tstate)) + if (thread_live_p (tstate)) flush_stack_call_func (thread_join_callback, tstate); return Qnil; @@ -961,7 +961,7 @@ DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0, for (iter = all_threads; iter; iter = iter->next_thread) { - if (thread_alive_p (iter)) + if (thread_live_p (iter)) { Lisp_Object thread; @@ -1051,7 +1051,7 @@ syms_of_threads (void) defsubr (&Scurrent_thread); defsubr (&Sthread_name); defsubr (&Sthread_signal); - defsubr (&Sthread_alive_p); + defsubr (&Sthread_live_p); defsubr (&Sthread_join); defsubr (&Sthread_blocker); defsubr (&Sall_threads); @@ -1069,6 +1069,9 @@ syms_of_threads (void) staticpro (&last_thread_error); last_thread_error = Qnil; + Fdefalias (intern_c_string ("thread-alive-p"), + intern_c_string ("thread-live-p"), Qnil); + Fprovide (intern_c_string ("threads"), Qnil); } diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index a00a9c84bd6..e721e0f9621 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -32,7 +32,7 @@ (declare-function mutex-lock "thread.c" (mutex)) (declare-function mutex-unlock "thread.c" (mutex)) (declare-function thread--blocker "thread.c" (thread)) -(declare-function thread-alive-p "thread.c" (thread)) +(declare-function thread-live-p "thread.c" (thread)) (declare-function thread-join "thread.c" (thread)) (declare-function thread-last-error "thread.c" ()) (declare-function thread-name "thread.c" (thread)) @@ -60,11 +60,11 @@ (should (string= "hi bob" (thread-name (make-thread #'ignore "hi bob"))))) -(ert-deftest threads-alive () +(ert-deftest threads-live () "Test for thread liveness." (skip-unless (featurep 'threads)) (should - (thread-alive-p (make-thread #'ignore)))) + (thread-live-p (make-thread #'ignore)))) (ert-deftest threads-all-threads () "Simple test for all-threads." @@ -96,7 +96,7 @@ (let ((thread (make-thread #'threads-test-thread1))) (thread-join thread) (and threads-test-global - (not (thread-alive-p thread))))))) + (not (thread-live-p thread))))))) (ert-deftest threads-join-self () "Cannot `thread-join' the current thread." @@ -271,7 +271,7 @@ (let (th1 th2) (setq th1 (make-thread #'threads-call-error "call-error")) (should (threadp th1)) - (while (thread-alive-p th1) + (while (thread-live-p th1) (thread-yield)) (should (equal (thread-last-error) '(error "Error is called"))) @@ -297,7 +297,7 @@ (while t (thread-yield)))))) (thread-signal thread 'error nil) (sit-for 1) - (should-not (thread-alive-p thread)) + (should-not (thread-live-p thread)) (should (equal (thread-last-error) '(error))))) (defvar threads-condvar nil) @@ -323,7 +323,7 @@ (setq new-thread (make-thread #'threads-test-condvar-wait)) ;; Make sure new-thread is alive. - (should (thread-alive-p new-thread)) + (should (thread-live-p new-thread)) (should (= (length (all-threads)) 2)) ;; Wait for new-thread to become blocked on the condvar. (while (not (eq (thread--blocker new-thread) threads-condvar)) @@ -336,7 +336,7 @@ (sleep-for 0.1) ;; Make sure the thread is still there. This used to fail due to ;; a bug in thread.c:condition_wait_callback. - (should (thread-alive-p new-thread)) + (should (thread-live-p new-thread)) (should (= (length (all-threads)) 2)) (should (eq (thread--blocker new-thread) threads-condvar)) From ee2509bd828070ae5d17fcc766f81715050ba673 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 31 Aug 2018 11:45:37 +0200 Subject: [PATCH 26/26] Mark thread-alive-p as obsolete * etc/NEWS (thread-alive-p): * lisp/emacs-lisp/thread.el (thread-alive-p): Mark it as obsolete. * test/src/thread-tests.el (threads-join-error) (threads-signal-main-thread): Use `thread-live-p'. --- etc/NEWS | 3 +++ lisp/emacs-lisp/thread.el | 2 ++ test/src/thread-tests.el | 4 ++-- 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index d536faaa2d6..1fe662ffffd 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -730,6 +730,9 @@ to signal the main thread, e.g., when they encounter an error. *** 'thread-signal' does not propagate errors to the main thread. Instead, error messages are just printed in the main thread. +--- +*** 'thread-alive-p' is now obsolete, use 'thread-live-p' instead. + --- ** thingatpt.el supports a new "thing" called 'uuid'. A symbol 'uuid' can be passed to thing-at-point and it returns the diff --git a/lisp/emacs-lisp/thread.el b/lisp/emacs-lisp/thread.el index 02cf9b9e53f..5d7b90c26e9 100644 --- a/lisp/emacs-lisp/thread.el +++ b/lisp/emacs-lisp/thread.el @@ -38,5 +38,7 @@ An EVENT has the format (err (cddr event))) (message "Error %s: %S" thread err)))) +(make-obsolete 'thread-alive-p 'thread-live-p "27.1") + (provide 'thread) ;;; thread.el ends here diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index a87eb3e1591..109e71128ab 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -116,7 +116,7 @@ :tags '(:unstable) (skip-unless (featurep 'threads)) (let ((thread (make-thread #'threads-call-error))) - (while (thread-alive-p thread) + (while (thread-live-p thread) (thread-yield)) (should-error (thread-join thread)))) @@ -332,7 +332,7 @@ (erase-buffer)) (let ((thread (make-thread #'(lambda () (thread-signal main-thread 'error nil))))) - (while (thread-alive-p thread) + (while (thread-live-p thread) (thread-yield)) (read-event nil nil 0.1) ;; No error has been raised, which is part of the test.