pestctrl/emacs
1
0
Fork 0
forked from Github/emacs
Code Issues Pull requests Projects Releases Packages Wiki Activity

Merge branch 'master' into feature/tramp-thread-safe

Browse source
This commit is contained in:
Michael Albinus 2018-08-31 13:10:21 +02:00
commit 1ed8d0030b
31 changed files with 562 additions and 390 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
admin/admin.el
View file

@ -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)

16
build-aux/git-hooks/pre-commit
View file

@ -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

24
configure.ac
View file

@ -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} ;;

3
doc/lispref/debugging.texi
View file

@ -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

12
doc/lispref/threads.texi
View file

@ -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

60
doc/misc/rcirc.texi
View file

@ -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

9
etc/NEWS
View file

@ -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;

5
etc/NEWS.26
View file

@ -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

20
etc/PROBLEMS
View file

@ -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.

4
lisp/calc/calc-cplx.el
View file

@ -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.

2
lisp/emacs-lisp/checkdoc.el
View file

@ -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

44
lisp/emacs-lisp/thread.el Normal file
View file

@ -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 <gazally@runbox.com>
;; 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 <https://www.gnu.org/licenses/>.
;;; 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

12
lisp/gnus/mm-view.el
View file

@ -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

8
lisp/vc/vc.el
View file

@ -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)

22
src/alloc.c
View file

@ -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);
}

37
src/bignum.c
View file

@ -23,6 +23,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include "lisp.h"
#include <stdlib.h>
/* 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;
}

369
src/editfns.c
View file

@ -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)

8
src/emacs-module.c
View file

@ -27,7 +27,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <stdio.h>
#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);
}

2
src/eval.c
View file

@ -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). */

2
src/font.c
View file

@ -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)
{

3
src/image.c
View file

@ -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;

27
src/keyboard.c
View file

@ -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. */

93
src/keymap.c
View file

@ -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))

5
src/lisp.h
View file

@ -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);

9
src/print.c
View file

@ -23,7 +23,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#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;

4
src/termhooks.h
View file

@ -222,6 +222,10 @@ enum event_kind
, DBUS_EVENT
#endif
#ifdef THREADS_ENABLED
, THREAD_EVENT
#endif
, CONFIG_CHANGED_EVENT
#ifdef HAVE_NTGUI

52
src/thread.c
View file

@ -25,6 +25,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#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);
}

20
src/xdisp.c
View file

@ -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;
}
}

7
test/lisp/calc/calc-tests.el
View file

@ -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))

17
test/src/editfns-tests.el
View file

@ -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

39
test/src/thread-tests.el
View file

@ -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))