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) 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 diff --git a/configure.ac b/configure.ac index 31750ef66a7..6f3d7338c35 100644 --- a/configure.ac +++ b/configure.ac @@ -363,7 +363,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]) @@ -1557,7 +1557,6 @@ case $opsys in LIB_MATH= SYSTEM_TYPE=windows-nt ;; - dnl NB this may be adjusted below. netbsd | openbsd ) SYSTEM_TYPE=berkeley-unix ;; @@ -2516,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. @@ -2544,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= @@ -3170,11 +3166,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 @@ -5429,12 +5426,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 JSON CANNOT_DUMP LCMS2 GMP; 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 JSON CANNOT_DUMP LCMS2 GMP; 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} ;; diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 9b3ba6cf7ee..89927db21ec 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -983,6 +983,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 diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi index 58a3a918efd..9cdeb798c1d 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 @@ -106,7 +100,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/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 diff --git a/etc/NEWS b/etc/NEWS index 733bd1da8d0..970a422b17b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -739,6 +739,13 @@ 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. + +--- +*** '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 @@ -878,6 +885,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/etc/NEWS.26 b/etc/NEWS.26 index e94bda549ab..97222705e61 100644 --- a/etc/NEWS.26 +++ b/etc/NEWS.26 @@ -99,6 +99,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/etc/PROBLEMS b/etc/PROBLEMS index a1fae225742..b863572e040 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -205,6 +205,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. 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. diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 1b3b23d8871..83929beb1e0 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1837,7 +1837,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 diff --git a/lisp/emacs-lisp/thread.el b/lisp/emacs-lisp/thread.el new file mode 100644 index 00000000000..5d7b90c26e9 --- /dev/null +++ b/lisp/emacs-lisp/thread.el @@ -0,0 +1,44 @@ +;;; 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)))) + +(make-obsolete 'thread-alive-p 'thread-live-p "27.1") + +(provide 'thread) +;;; thread.el ends here 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 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) 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); } 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/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); } diff --git a/src/eval.c b/src/eval.c index 8745ba9ef99..50de60c936c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -787,7 +787,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). */ 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) { 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; 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/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)) 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/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..fc933440fcc 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,14 +35,13 @@ 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; /* 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) @@ -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,18 +875,36 @@ 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; +#ifdef THREADS_ENABLED + 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 +#endif + { + /* 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; } -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) { @@ -894,7 +913,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, @@ -924,7 +943,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; @@ -951,7 +970,7 @@ is an error for a thread to try to join itself. */) error_symbol = tstate->error_symbol; error_data = tstate->error_data; - if (thread_alive_p (tstate)) + if (thread_live_p (tstate)) flush_stack_call_func (thread_join_callback, tstate); if (!NILP (error_symbol)) @@ -969,7 +988,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; @@ -1074,7 +1093,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); @@ -1092,6 +1111,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/src/xdisp.c b/src/xdisp.c index 11b14e2cf95..04033665d76 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -21185,8 +21185,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 @@ -21210,18 +21214,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; } } 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)) 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 diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 364f6d61f05..109e71128ab 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)) @@ -32,7 +34,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" (&optional cleanup)) (declare-function thread-name "thread.c" (thread)) @@ -61,11 +63,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." @@ -102,7 +104,7 @@ (let ((thread (make-thread #'threads-test-thread1))) (and (= (thread-join thread) 23) (= threads-test-global 23) - (not (thread-alive-p thread))))))) + (not (thread-live-p thread))))))) (ert-deftest threads-join-self () "Cannot `thread-join' the current thread." @@ -114,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)))) @@ -288,7 +290,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"))) @@ -317,9 +319,28 @@ (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))))) +(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-live-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 () @@ -343,7 +364,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)) @@ -356,7 +377,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))