aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog.24
-rw-r--r--ChangeLog.38
-rwxr-xr-xbuild-aux/config.guess38
-rwxr-xr-xbuild-aux/config.sub20
-rwxr-xr-xbuild-aux/gitlog-to-changelog2
-rw-r--r--configure.ac8
-rw-r--r--doc/emacs/anti.texi2
-rw-r--r--doc/emacs/cmdargs.texi10
-rw-r--r--doc/emacs/display.texi15
-rw-r--r--doc/lispref/buffers.texi15
-rw-r--r--doc/lispref/files.texi8
-rw-r--r--doc/lispref/frames.texi58
-rw-r--r--doc/lispref/os.texi4
-rw-r--r--doc/lispref/strings.texi5
-rw-r--r--doc/lispref/text.texi24
-rw-r--r--doc/lispref/tips.texi11
-rw-r--r--doc/misc/texinfo.tex14
-rw-r--r--doc/misc/tramp.texi8
-rw-r--r--doc/misc/trampver.texi2
-rw-r--r--etc/NEWS36
-rw-r--r--lib-src/etags.c16
-rw-r--r--lib/allocator.h2
-rw-r--r--lib/count-leading-zeros.h3
-rw-r--r--lib/count-trailing-zeros.h3
-rw-r--r--lib/dup2.c2
-rw-r--r--lib/filevercmp.c2
-rw-r--r--lib/fstatat.c2
-rw-r--r--lib/fsync.c4
-rw-r--r--lib/ftoastr.c2
-rw-r--r--lib/ftoastr.h2
-rw-r--r--lib/gnulib.mk.in1
-rw-r--r--lib/intprops.h6
-rw-r--r--lib/signal.in.h2
-rw-r--r--lib/stdio-impl.h10
-rw-r--r--lib/stdio.in.h4
-rw-r--r--lib/unistd.in.h4
-rw-r--r--lib/utimens.c10
-rw-r--r--lisp/calendar/cal-tex.el2
-rw-r--r--lisp/emacs-lisp/ert-x.el57
-rw-r--r--lisp/emacs-lisp/ert.el5
-rw-r--r--lisp/emacs-lisp/smie.el4
-rw-r--r--lisp/emacs-lisp/subr-x.el2
-rw-r--r--lisp/emacs-lisp/syntax.el107
-rw-r--r--lisp/emacs-lisp/timer-list.el6
-rw-r--r--lisp/eshell/esh-util.el2
-rw-r--r--lisp/files.el42
-rw-r--r--lisp/frame.el20
-rw-r--r--lisp/frameset.el13
-rw-r--r--lisp/gnus/message.el1
-rw-r--r--lisp/mouse.el28
-rw-r--r--lisp/mwheel.el1
-rw-r--r--lisp/net/mailcap.el6
-rw-r--r--lisp/net/tramp-adb.el2
-rw-r--r--lisp/net/tramp-compat.el33
-rw-r--r--lisp/net/tramp-sh.el28
-rw-r--r--lisp/net/tramp-smb.el10
-rw-r--r--lisp/net/tramp.el33
-rw-r--r--lisp/net/trampver.el9
-rw-r--r--lisp/org/ChangeLog.14
-rw-r--r--lisp/progmodes/bat-mode.el6
-rw-r--r--lisp/progmodes/flymake-proc.el1100
-rw-r--r--lisp/progmodes/flymake-ui.el634
-rw-r--r--lisp/progmodes/flymake.el1629
-rw-r--r--lisp/progmodes/python.el6
-rw-r--r--lisp/progmodes/sh-script.el34
-rw-r--r--lisp/progmodes/xref.el2
-rw-r--r--lisp/simple.el59
-rw-r--r--lisp/subr.el7
-rw-r--r--lisp/term/ns-win.el19
-rw-r--r--lisp/textmodes/css-mode.el2
-rw-r--r--lisp/textmodes/ispell.el6
-rw-r--r--lisp/textmodes/page-ext.el2
-rw-r--r--lisp/vc/log-view.el14
-rw-r--r--lisp/vc/smerge-mode.el2
-rw-r--r--lisp/vc/vc-git.el2
-rw-r--r--lisp/xdg.el4
-rw-r--r--m4/alloca.m44
-rw-r--r--m4/extern-inline.m48
-rw-r--r--m4/fstatat.m42
-rw-r--r--m4/gnulib-common.m46
-rw-r--r--m4/manywarnings.m417
-rw-r--r--m4/std-gnu11.m44
-rw-r--r--m4/sys_types_h.m42
-rw-r--r--m4/vararrays.m42
-rw-r--r--src/Makefile.in2
-rw-r--r--src/callint.c7
-rw-r--r--src/data.c12
-rw-r--r--src/dbusbind.c3
-rw-r--r--src/editfns.c49
-rw-r--r--src/emacs.c8
-rw-r--r--src/eval.c2
-rw-r--r--src/gtkutil.c5
-rw-r--r--src/keyboard.c5
-rw-r--r--src/lcms.c111
-rw-r--r--src/lisp.h1
-rw-r--r--src/nsterm.m173
-rw-r--r--src/term.c12
-rw-r--r--src/termhooks.h4
-rw-r--r--src/w32term.c6
-rw-r--r--src/xdisp.c8
-rw-r--r--test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el130
-rw-r--r--test/lisp/emacs-lisp/edebug-tests.el903
-rw-r--r--test/lisp/emacs-lisp/subr-x-tests.el9
-rw-r--r--test/lisp/files-tests.el20
-rw-r--r--test/lisp/ibuffer-tests.el51
-rw-r--r--test/lisp/net/tramp-tests.el22
-rw-r--r--test/lisp/subr-tests.el6
-rw-r--r--test/lisp/textmodes/css-mode-tests.el21
-rw-r--r--test/lisp/vc/smerge-mode-tests.el34
-rw-r--r--test/lisp/xdg-tests.el3
-rw-r--r--test/src/data-tests.el6
-rw-r--r--test/src/editfns-tests.el8
-rw-r--r--test/src/fileio-tests.el2
-rw-r--r--test/src/lcms-tests.el41
114 files changed, 3759 insertions, 2260 deletions
diff --git a/ChangeLog.2 b/ChangeLog.2
index bd1800b3307..e789722a4d6 100644
--- a/ChangeLog.2
+++ b/ChangeLog.2
@@ -4808,7 +4808,7 @@
4808 Link from (emacs)Exiting to (lisp)Killing Emacs 4808 Link from (emacs)Exiting to (lisp)Killing Emacs
4809 4809
4810 * doc/emacs/entering.texi (Exiting): Link to the lispref 4810 * doc/emacs/entering.texi (Exiting): Link to the lispref
4811 manual for further customisations (bug#15445). 4811 manual for further customizations (bug#15445).
4812 4812
4813 (cherry picked from commit bc5f27aa099cdde02ca66e71501b89300685ab28) 4813 (cherry picked from commit bc5f27aa099cdde02ca66e71501b89300685ab28)
4814 4814
@@ -7845,7 +7845,7 @@
7845 7845
78462016-02-20 Lars Ingebrigtsen <larsi@gnus.org> 78462016-02-20 Lars Ingebrigtsen <larsi@gnus.org>
7847 7847
7848 Allow customising the article mode cursor behavior 7848 Allow customizing the article mode cursor behavior
7849 7849
7850 * doc/misc/gnus.texi (HTML): Mention gnus-article-show-cursor. 7850 * doc/misc/gnus.texi (HTML): Mention gnus-article-show-cursor.
7851 7851
diff --git a/ChangeLog.3 b/ChangeLog.3
index 9f43511991c..9e622cef90f 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -12949,7 +12949,7 @@
12949 Link from (emacs)Exiting to (lisp)Killing Emacs 12949 Link from (emacs)Exiting to (lisp)Killing Emacs
12950 12950
12951 * doc/emacs/entering.texi (Exiting): Link to the lispref 12951 * doc/emacs/entering.texi (Exiting): Link to the lispref
12952 manual for further customisations (bug#15445). 12952 manual for further customizations (bug#15445).
12953 12953
129542016-04-29 Lars Ingebrigtsen <larsi@gnus.org> 129542016-04-29 Lars Ingebrigtsen <larsi@gnus.org>
12955 12955
@@ -13159,7 +13159,7 @@
13159 Move the diff command to "Operate" in ibuffer 13159 Move the diff command to "Operate" in ibuffer
13160 13160
13161 * lisp/ibuffer.el (ibuffer-mode-operate-map): Move the diff 13161 * lisp/ibuffer.el (ibuffer-mode-operate-map): Move the diff
13162 command to the "Operate" menu, and remove the customisation 13162 command to the "Operate" menu, and remove the customization
13163 entry to make the "View" menu more logical (bug#1150). 13163 entry to make the "View" menu more logical (bug#1150).
13164 13164
131652016-04-27 Lars Ingebrigtsen <larsi@gnus.org> 131652016-04-27 Lars Ingebrigtsen <larsi@gnus.org>
@@ -16589,7 +16589,7 @@
16589 really changed. 16589 really changed.
16590 (save_window_save): Set the pixel_height_before_size_change and 16590 (save_window_save): Set the pixel_height_before_size_change and
16591 pixel_width_before_size_change fields. 16591 pixel_width_before_size_change fields.
16592 (Vwindow_size_change_functions): Move here definiton from xdisp.c. 16592 (Vwindow_size_change_functions): Move here definition from xdisp.c.
16593 * src/xdisp.c (prepare_menu_bars, redisplay_internal): Call 16593 * src/xdisp.c (prepare_menu_bars, redisplay_internal): Call
16594 run_window_size_change_functions. 16594 run_window_size_change_functions.
16595 (Vwindow_size_change_functions): Move definition to window.c. 16595 (Vwindow_size_change_functions): Move definition to window.c.
@@ -16842,7 +16842,7 @@
16842 5d17ae7 Improve file-notify-test08-watched-file-in-watched-dir 16842 5d17ae7 Improve file-notify-test08-watched-file-in-watched-dir
16843 1cb1268 Fix todo-mode item date editing bugs 16843 1cb1268 Fix todo-mode item date editing bugs
16844 1e996cf Fix "[:upper:]" for non-ASCII characters 16844 1e996cf Fix "[:upper:]" for non-ASCII characters
16845 896f993 Allow customising the article mode cursor behavior 16845 896f993 Allow customizing the article mode cursor behavior
16846 24c1c1d Use pop-to-buffer-same-window in woman.el 16846 24c1c1d Use pop-to-buffer-same-window in woman.el
16847 2a75f64 New filenotify test for bug#22736 16847 2a75f64 New filenotify test for bug#22736
16848 c9bccf7 Report critical battery errors 16848 c9bccf7 Report critical battery errors
diff --git a/build-aux/config.guess b/build-aux/config.guess
index a7448442748..8bd1095f112 100755
--- a/build-aux/config.guess
+++ b/build-aux/config.guess
@@ -2,7 +2,7 @@
2# Attempt to guess a canonical system name. 2# Attempt to guess a canonical system name.
3# Copyright 1992-2017 Free Software Foundation, Inc. 3# Copyright 1992-2017 Free Software Foundation, Inc.
4 4
5timestamp='2017-08-08' 5timestamp='2017-09-16'
6 6
7# This file is free software; you can redistribute it and/or modify it 7# This file is free software; you can redistribute it and/or modify it
8# under the terms of the GNU General Public License as published by 8# under the terms of the GNU General Public License as published by
@@ -15,7 +15,7 @@ timestamp='2017-08-08'
15# General Public License for more details. 15# General Public License for more details.
16# 16#
17# You should have received a copy of the GNU General Public License 17# You should have received a copy of the GNU General Public License
18# along with this program; if not, see <http://www.gnu.org/licenses/>. 18# along with this program; if not, see <https://www.gnu.org/licenses/>.
19# 19#
20# As a special exception to the GNU General Public License, if you 20# As a special exception to the GNU General Public License, if you
21# distribute this file as part of a program that contains a 21# distribute this file as part of a program that contains a
@@ -27,7 +27,7 @@ timestamp='2017-08-08'
27# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. 27# Originally written by Per Bothner; maintained since 2000 by Ben Elliston.
28# 28#
29# You can get the latest version of this script from: 29# You can get the latest version of this script from:
30# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess 30# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
31# 31#
32# Please send patches to <config-patches@gnu.org>. 32# Please send patches to <config-patches@gnu.org>.
33 33
@@ -318,15 +318,6 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
318 exitcode=$? 318 exitcode=$?
319 trap '' 0 319 trap '' 0
320 exit $exitcode ;; 320 exit $exitcode ;;
321 Alpha\ *:Windows_NT*:*)
322 # How do we know it's Interix rather than the generic POSIX subsystem?
323 # Should we change UNAME_MACHINE based on the output of uname instead
324 # of the specific Alpha model?
325 echo alpha-pc-interix
326 exit ;;
327 21064:Windows_NT:50:3)
328 echo alpha-dec-winnt3.5
329 exit ;;
330 Amiga*:UNIX_System_V:4.0:*) 321 Amiga*:UNIX_System_V:4.0:*)
331 echo m68k-unknown-sysv4 322 echo m68k-unknown-sysv4
332 exit ;; 323 exit ;;
@@ -858,10 +849,6 @@ EOF
858 *:MSYS*:*) 849 *:MSYS*:*)
859 echo ${UNAME_MACHINE}-pc-msys 850 echo ${UNAME_MACHINE}-pc-msys
860 exit ;; 851 exit ;;
861 i*:windows32*:*)
862 # uname -m includes "-pc" on this system.
863 echo ${UNAME_MACHINE}-mingw32
864 exit ;;
865 i*:PW*:*) 852 i*:PW*:*)
866 echo ${UNAME_MACHINE}-pc-pw32 853 echo ${UNAME_MACHINE}-pc-pw32
867 exit ;; 854 exit ;;
@@ -877,27 +864,12 @@ EOF
877 echo ia64-unknown-interix${UNAME_RELEASE} 864 echo ia64-unknown-interix${UNAME_RELEASE}
878 exit ;; 865 exit ;;
879 esac ;; 866 esac ;;
880 [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*)
881 echo i${UNAME_MACHINE}-pc-mks
882 exit ;;
883 8664:Windows_NT:*)
884 echo x86_64-pc-mks
885 exit ;;
886 i*:Windows_NT*:* | Pentium*:Windows_NT*:*)
887 # How do we know it's Interix rather than the generic POSIX subsystem?
888 # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we
889 # UNAME_MACHINE based on the output of uname instead of i386?
890 echo i586-pc-interix
891 exit ;;
892 i*:UWIN*:*) 867 i*:UWIN*:*)
893 echo ${UNAME_MACHINE}-pc-uwin 868 echo ${UNAME_MACHINE}-pc-uwin
894 exit ;; 869 exit ;;
895 amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) 870 amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*)
896 echo x86_64-unknown-cygwin 871 echo x86_64-unknown-cygwin
897 exit ;; 872 exit ;;
898 p*:CYGWIN*:*)
899 echo powerpcle-unknown-cygwin
900 exit ;;
901 prep*:SunOS:5.*:*) 873 prep*:SunOS:5.*:*)
902 echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` 874 echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
903 exit ;; 875 exit ;;
@@ -1435,9 +1407,9 @@ This script (version $timestamp), has failed to recognize the
1435operating system you are using. If your script is old, overwrite *all* 1407operating system you are using. If your script is old, overwrite *all*
1436copies of config.guess and config.sub with the latest versions from: 1408copies of config.guess and config.sub with the latest versions from:
1437 1409
1438 http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess 1410 https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
1439and 1411and
1440 http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub 1412 https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
1441 1413
1442If $0 has already been updated, send the following data and any 1414If $0 has already been updated, send the following data and any
1443information you think might be pertinent to config-patches@gnu.org to 1415information you think might be pertinent to config-patches@gnu.org to
diff --git a/build-aux/config.sub b/build-aux/config.sub
index 40ea5dfe115..95dc3d07248 100755
--- a/build-aux/config.sub
+++ b/build-aux/config.sub
@@ -2,7 +2,7 @@
2# Configuration validation subroutine script. 2# Configuration validation subroutine script.
3# Copyright 1992-2017 Free Software Foundation, Inc. 3# Copyright 1992-2017 Free Software Foundation, Inc.
4 4
5timestamp='2017-04-02' 5timestamp='2017-09-16'
6 6
7# This file is free software; you can redistribute it and/or modify it 7# This file is free software; you can redistribute it and/or modify it
8# under the terms of the GNU General Public License as published by 8# under the terms of the GNU General Public License as published by
@@ -15,7 +15,7 @@ timestamp='2017-04-02'
15# General Public License for more details. 15# General Public License for more details.
16# 16#
17# You should have received a copy of the GNU General Public License 17# You should have received a copy of the GNU General Public License
18# along with this program; if not, see <http://www.gnu.org/licenses/>. 18# along with this program; if not, see <https://www.gnu.org/licenses/>.
19# 19#
20# As a special exception to the GNU General Public License, if you 20# As a special exception to the GNU General Public License, if you
21# distribute this file as part of a program that contains a 21# distribute this file as part of a program that contains a
@@ -33,7 +33,7 @@ timestamp='2017-04-02'
33# Otherwise, we print the canonical config type on stdout and succeed. 33# Otherwise, we print the canonical config type on stdout and succeed.
34 34
35# You can get the latest version of this script from: 35# You can get the latest version of this script from:
36# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub 36# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
37 37
38# This file is supposed to be the same for all GNU packages 38# This file is supposed to be the same for all GNU packages
39# and recognize all the CPU types, system types and aliases 39# and recognize all the CPU types, system types and aliases
@@ -229,9 +229,6 @@ case $os in
229 -ptx*) 229 -ptx*)
230 basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` 230 basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
231 ;; 231 ;;
232 -windowsnt*)
233 os=`echo $os | sed -e 's/windowsnt/winnt/'`
234 ;;
235 -psos*) 232 -psos*)
236 os=-psos 233 os=-psos
237 ;; 234 ;;
@@ -1259,6 +1256,9 @@ case $basic_machine in
1259 basic_machine=hppa1.1-winbond 1256 basic_machine=hppa1.1-winbond
1260 os=-proelf 1257 os=-proelf
1261 ;; 1258 ;;
1259 x64)
1260 basic_machine=x86_64-pc
1261 ;;
1262 xbox) 1262 xbox)
1263 basic_machine=i686-pc 1263 basic_machine=i686-pc
1264 os=-mingw32 1264 os=-mingw32
@@ -1366,8 +1366,8 @@ esac
1366if [ x"$os" != x"" ] 1366if [ x"$os" != x"" ]
1367then 1367then
1368case $os in 1368case $os in
1369 # First match some system type aliases 1369 # First match some system type aliases that might get confused
1370 # that might get confused with valid system types. 1370 # with valid system types.
1371 # -solaris* is a basic system type, with this one exception. 1371 # -solaris* is a basic system type, with this one exception.
1372 -auroraux) 1372 -auroraux)
1373 os=-auroraux 1373 os=-auroraux
@@ -1387,9 +1387,9 @@ case $os in
1387 -gnu/linux*) 1387 -gnu/linux*)
1388 os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` 1388 os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'`
1389 ;; 1389 ;;
1390 # First accept the basic system types. 1390 # Now accept the basic system types.
1391 # The portable systems comes first. 1391 # The portable systems comes first.
1392 # Each alternative MUST END IN A *, to match a version number. 1392 # Each alternative MUST end in a * to match a version number.
1393 # -sysv* is not here because it comes later, after sysvr4. 1393 # -sysv* is not here because it comes later, after sysvr4.
1394 -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ 1394 -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
1395 | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ 1395 | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\
diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog
index ec5ab9e141c..3c94bd56a0b 100755
--- a/build-aux/gitlog-to-changelog
+++ b/build-aux/gitlog-to-changelog
@@ -33,7 +33,7 @@ use POSIX qw(strftime);
33 33
34(my $ME = $0) =~ s|.*/||; 34(my $ME = $0) =~ s|.*/||;
35 35
36# use File::Coda; # http://meyering.net/code/Coda/ 36# use File::Coda; # https://meyering.net/code/Coda/
37END { 37END {
38 defined fileno STDOUT or return; 38 defined fileno STDOUT or return;
39 close STDOUT and return; 39 close STDOUT and return;
diff --git a/configure.ac b/configure.ac
index 6452038d1b9..0b0bb5e144b 100644
--- a/configure.ac
+++ b/configure.ac
@@ -2077,15 +2077,15 @@ if test "${HAVE_W32}" = "yes"; then
2077 AC_SUBST(comma_space_version) 2077 AC_SUBST(comma_space_version)
2078 AC_CONFIG_FILES([nt/emacs.rc nt/emacsclient.rc]) 2078 AC_CONFIG_FILES([nt/emacs.rc nt/emacsclient.rc])
2079 if test "${opsys}" = "cygwin"; then 2079 if test "${opsys}" = "cygwin"; then
2080 W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32" 2080 W32_LIBS="$W32_LIBS -lkernel32 -luser32 -lusp10 -lgdi32"
2081 W32_LIBS="$W32_LIBS -lusp10 -lcomctl32 -lwinspool" 2081 W32_LIBS="$W32_LIBS -lole32 -lcomdlg32 -lcomctl32 -lwinspool"
2082 # Tell the linker that emacs.res is an object (which we compile from 2082 # Tell the linker that emacs.res is an object (which we compile from
2083 # the rc file), not a linker script. 2083 # the rc file), not a linker script.
2084 W32_RES_LINK="-Wl,emacs.res" 2084 W32_RES_LINK="-Wl,emacs.res"
2085 else 2085 else
2086 W32_OBJ="$W32_OBJ w32.o w32console.o w32heap.o w32inevt.o w32proc.o" 2086 W32_OBJ="$W32_OBJ w32.o w32console.o w32heap.o w32inevt.o w32proc.o"
2087 W32_LIBS="$W32_LIBS -lwinmm -lgdi32 -lcomdlg32" 2087 W32_LIBS="$W32_LIBS -lwinmm -lusp10 -lgdi32 -lcomdlg32"
2088 W32_LIBS="$W32_LIBS -lmpr -lwinspool -lole32 -lcomctl32 -lusp10" 2088 W32_LIBS="$W32_LIBS -lmpr -lwinspool -lole32 -lcomctl32"
2089 W32_RES_LINK="\$(EMACSRES)" 2089 W32_RES_LINK="\$(EMACSRES)"
2090 CLIENTRES="emacsclient.res" 2090 CLIENTRES="emacsclient.res"
2091 CLIENTW="emacsclientw\$(EXEEXT)" 2091 CLIENTW="emacsclientw\$(EXEEXT)"
diff --git a/doc/emacs/anti.texi b/doc/emacs/anti.texi
index ffec915cb13..547dbd1b45d 100644
--- a/doc/emacs/anti.texi
+++ b/doc/emacs/anti.texi
@@ -94,7 +94,7 @@ happen. The variables @code{'attempt-stack-overflow-recovery} and
94@code{attempt-orderly-shutdown-on-fatal-signal} are therefore removed. 94@code{attempt-orderly-shutdown-on-fatal-signal} are therefore removed.
95 95
96@item 96@item
97The @code{timer-list} command was removed, as we decided timers are 97The @code{list-timers} command was removed, as we decided timers are
98not user-level feature, and therefore users should not be allowed to 98not user-level feature, and therefore users should not be allowed to
99mess with them. Ask an Emacs Lisp guru near you for help if you have 99mess with them. Ask an Emacs Lisp guru near you for help if you have
100a runaway timer in your session. (Of course, as you move back in 100a runaway timer in your session. (Of course, as you move back in
diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi
index 819459e0af0..618a05d451b 100644
--- a/doc/emacs/cmdargs.texi
+++ b/doc/emacs/cmdargs.texi
@@ -92,7 +92,7 @@ arguments.)
92@itemx --visit=@var{file} 92@itemx --visit=@var{file}
93@cindex visiting files, command-line argument 93@cindex visiting files, command-line argument
94@vindex inhibit-startup-buffer-menu 94@vindex inhibit-startup-buffer-menu
95Visit @var{file} using @code{find-file}. @xref{Visiting}. 95Visit the specified @var{file}. @xref{Visiting}.
96 96
97When Emacs starts up, it displays the startup buffer in one window, 97When Emacs starts up, it displays the startup buffer in one window,
98and the buffer visiting @var{file} in another window 98and the buffer visiting @var{file} in another window
@@ -111,12 +111,12 @@ Buffer Menu for this, change the variable
111 111
112@item +@var{linenum} @var{file} 112@item +@var{linenum} @var{file}
113@opindex +@var{linenum} 113@opindex +@var{linenum}
114Visit @var{file} using @code{find-file}, then go to line number 114Visit the specified @var{file}, then go to line number @var{linenum}
115@var{linenum} in it. 115in it.
116 116
117@item +@var{linenum}:@var{columnnum} @var{file} 117@item +@var{linenum}:@var{columnnum} @var{file}
118Visit @var{file} using @code{find-file}, then go to line number 118Visit the specified @var{file}, then go to line number @var{linenum}
119@var{linenum} and put point at column number @var{columnnum}. 119and put point at column number @var{columnnum}.
120 120
121@item -l @var{file} 121@item -l @var{file}
122@opindex -l 122@opindex -l
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index 2aa79e1161a..6afd8366b25 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -1745,7 +1745,7 @@ invisible parts of text), and lines which wrap to consume more than
1745one screen line will be numbered that many times. The displayed 1745one screen line will be numbered that many times. The displayed
1746numbers are relative, as with @code{relative} value above. This is 1746numbers are relative, as with @code{relative} value above. This is
1747handy in modes that fold text, such as Outline mode (@pxref{Outline 1747handy in modes that fold text, such as Outline mode (@pxref{Outline
1748Mode}), and need to move by exact number of screen lines. 1748Mode}), and when you need to move by exact number of screen lines.
1749 1749
1750@item anything else 1750@item anything else
1751Any other non-@code{nil} value is treated as @code{t}. 1751Any other non-@code{nil} value is treated as @code{t}.
@@ -1756,7 +1756,7 @@ Any other non-@code{nil} value is treated as @code{t}.
1756@vindex display-line-numbers-type 1756@vindex display-line-numbers-type
1757A convenient way of turning on display of line numbers is @w{@kbd{M-x 1757A convenient way of turning on display of line numbers is @w{@kbd{M-x
1758display-line-numbers-mode @key{RET}}}. This mode has a globalized 1758display-line-numbers-mode @key{RET}}}. This mode has a globalized
1759variant, @code{global-display-line0numbers-mode}. The user option 1759variant, @code{global-display-line-numbers-mode}. The user option
1760@code{display-line-numbers-type} controls which sub-mode of 1760@code{display-line-numbers-type} controls which sub-mode of
1761line-number display, described above, will these modes activate. 1761line-number display, described above, will these modes activate.
1762 1762
@@ -1778,6 +1778,17 @@ the variable @code{display-line-numbers-widen} to a non-@code{nil}
1778value, line numbers will disregard any narrowing and will start at the 1778value, line numbers will disregard any narrowing and will start at the
1779first character of the buffer. 1779first character of the buffer.
1780 1780
1781@vindex display-line-numbers-width-start
1782@vindex display-line-numbers-grow-only
1783@vindex display-line-numbers-width
1784In selective display mode (@pxref{Selective Display}), and other modes
1785that hide many lines from display (such as Outline and Org modes), you
1786may wish to customize the variables
1787@code{display-line-numbers-width-start} and
1788@code{display-line-numbers-grow-only}, or set
1789@code{display-line-numbers-width} to a large enough value, to avoid
1790occasional miscalculations of space reserved for the line numbers.
1791
1781@cindex line-number face 1792@cindex line-number face
1782The line numbers are displayed in a special face @code{line-number}. 1793The line numbers are displayed in a special face @code{line-number}.
1783The current line number is displayed in a different face, 1794The current line number is displayed in a different face,
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index cf24a730ba6..0d02cb3d3e9 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -1089,12 +1089,15 @@ is not cleared by changing major modes.
1089 1089
1090@defopt buffer-offer-save 1090@defopt buffer-offer-save
1091This variable, if non-@code{nil} in a particular buffer, tells 1091This variable, if non-@code{nil} in a particular buffer, tells
1092@code{save-buffers-kill-emacs} and @code{save-some-buffers} (if the 1092@code{save-buffers-kill-emacs} to offer to save that buffer, just as
1093second optional argument to that function is @code{t}) to offer to 1093it offers to save file-visiting buffers. If @code{save-some-buffers}
1094save that buffer, just as they offer to save file-visiting buffers. 1094is called with the second optional argument set to @code{t}, it will
1095@xref{Definition of save-some-buffers}. The variable 1095also offer to save the buffer. Lastly, if this variable is set to the
1096@code{buffer-offer-save} automatically becomes buffer-local when set 1096symbol @code{always}, both @code{save-buffers-kill-emacs} and
1097for any reason. @xref{Buffer-Local Variables}. 1097@code{save-some-buffers} will always offer to save. @xref{Definition
1098of save-some-buffers}. The variable @code{buffer-offer-save}
1099automatically becomes buffer-local when set for any reason.
1100@xref{Buffer-Local Variables}.
1098@end defopt 1101@end defopt
1099 1102
1100@defvar buffer-save-without-query 1103@defvar buffer-save-without-query
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index 6be998f0b2e..f49b02de97c 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -332,7 +332,9 @@ in the list @code{find-file-hook}.
332that is visiting that file---that is, the contents of the file are 332that is visiting that file---that is, the contents of the file are
333copied into the buffer and the copy is what you edit. Changes to the 333copied into the buffer and the copy is what you edit. Changes to the
334buffer do not change the file until you @dfn{save} the buffer, which 334buffer do not change the file until you @dfn{save} the buffer, which
335means copying the contents of the buffer into the file. 335means copying the contents of the buffer into the file. Buffers which
336are not visiting a file can still be ``saved'', in a sense, using
337functions in the buffer-local @code{write-contents-functions} hook.
336 338
337@deffn Command save-buffer &optional backup-option 339@deffn Command save-buffer &optional backup-option
338This function saves the contents of the current buffer in its visited 340This function saves the contents of the current buffer in its visited
@@ -365,8 +367,8 @@ With an argument of 0, unconditionally do @emph{not} make any backup file.
365@anchor{Definition of save-some-buffers} 367@anchor{Definition of save-some-buffers}
366This command saves some modified file-visiting buffers. Normally it 368This command saves some modified file-visiting buffers. Normally it
367asks the user about each buffer. But if @var{save-silently-p} is 369asks the user about each buffer. But if @var{save-silently-p} is
368non-@code{nil}, it saves all the file-visiting buffers without querying 370non-@code{nil}, it saves all the file-visiting buffers without
369the user. 371querying the user.
370 372
371@vindex save-some-buffers-default-predicate 373@vindex save-some-buffers-default-predicate
372The optional @var{pred} argument provides a predicate that controls 374The optional @var{pred} argument provides a predicate that controls
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 6431bbdedb9..f66ecee8e8e 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -112,37 +112,39 @@ window of another Emacs frame. @xref{Child Frames}.
112* Display Feature Testing:: Determining the features of a terminal. 112* Display Feature Testing:: Determining the features of a terminal.
113@end menu 113@end menu
114 114
115
115@node Creating Frames 116@node Creating Frames
116@section Creating Frames 117@section Creating Frames
117@cindex frame creation 118@cindex frame creation
118 119
119To create a new frame, call the function @code{make-frame}. 120To create a new frame, call the function @code{make-frame}.
120 121
121@deffn Command make-frame &optional alist 122@deffn Command make-frame &optional parameters
122This function creates and returns a new frame, displaying the current 123This function creates and returns a new frame, displaying the current
123buffer. 124buffer.
124 125
125The @var{alist} argument is an alist that specifies frame parameters 126The @var{parameters} argument is an alist that specifies frame
126for the new frame. @xref{Frame Parameters}. If you specify the 127parameters for the new frame. @xref{Frame Parameters}. If you specify
127@code{terminal} parameter in @var{alist}, the new frame is created on 128the @code{terminal} parameter in @var{parameters}, the new frame is
128that terminal. Otherwise, if you specify the @code{window-system} 129created on that terminal. Otherwise, if you specify the
129frame parameter in @var{alist}, that determines whether the frame 130@code{window-system} frame parameter in @var{parameters}, that
130should be displayed on a text terminal or a graphical terminal. 131determines whether the frame should be displayed on a text terminal or a
131@xref{Window Systems}. If neither is specified, the new frame is 132graphical terminal. @xref{Window Systems}. If neither is specified,
132created in the same terminal as the selected frame. 133the new frame is created in the same terminal as the selected frame.
133 134
134Any parameters not mentioned in @var{alist} default to the values in 135Any parameters not mentioned in @var{parameters} default to the values
135the alist @code{default-frame-alist} (@pxref{Initial Parameters}); 136in the alist @code{default-frame-alist} (@pxref{Initial Parameters});
136parameters not specified there default from the X resources or its 137parameters not specified there default from the X resources or its
137equivalent on your operating system (@pxref{X Resources,, X Resources, 138equivalent on your operating system (@pxref{X Resources,, X Resources,
138emacs, The GNU Emacs Manual}). After the frame is created, Emacs 139emacs, The GNU Emacs Manual}). After the frame is created, this
139applies any parameters listed in @code{frame-inherited-parameters} 140function applies any parameters specified in
140(see below) and not present in the argument, taking the values from 141@code{frame-inherited-parameters} (see below) it has no assigned yet,
141the frame that was selected when @code{make-frame} was called. 142taking the values from the frame that was selected when
143@code{make-frame} was called.
142 144
143Note that on multi-monitor displays (@pxref{Multiple Terminals}), the 145Note that on multi-monitor displays (@pxref{Multiple Terminals}), the
144window manager might position the frame differently than specified by 146window manager might position the frame differently than specified by
145the positional parameters in @var{alist} (@pxref{Position 147the positional parameters in @var{parameters} (@pxref{Position
146Parameters}). For example, some window managers have a policy of 148Parameters}). For example, some window managers have a policy of
147displaying the frame on the monitor that contains the largest part of 149displaying the frame on the monitor that contains the largest part of
148the window (a.k.a.@: the @dfn{dominating} monitor). 150the window (a.k.a.@: the @dfn{dominating} monitor).
@@ -158,20 +160,28 @@ A normal hook run by @code{make-frame} before it creates the frame.
158@end defvar 160@end defvar
159 161
160@defvar after-make-frame-functions 162@defvar after-make-frame-functions
161An abnormal hook run by @code{make-frame} after it creates the frame. 163An abnormal hook run by @code{make-frame} after it created the frame.
162Each function in @code{after-make-frame-functions} receives one argument, the 164Each function in @code{after-make-frame-functions} receives one
163frame just created. 165argument, the frame just created.
164@end defvar 166@end defvar
165 167
168Note that any functions added to these hooks by your initial file are
169usually not run for the initial frame, since Emacs reads the initial
170file only after creating that frame. However, if the initial frame is
171specified to use a separate minibuffer frame (@pxref{Minibuffers and
172Frames}), the functions will be run for both, the minibuffer-less and
173the minibuffer frame.
174
166@defvar frame-inherited-parameters 175@defvar frame-inherited-parameters
167This variable specifies the list of frame parameters that a newly 176This variable specifies the list of frame parameters that a newly
168created frame inherits from the currently selected frame. For each 177created frame inherits from the currently selected frame. For each
169parameter (a symbol) that is an element in the list and is not present 178parameter (a symbol) that is an element in this list and has not been
170in the argument to @code{make-frame}, the function sets the value of 179assigned earlier when processing @code{make-frame}, the function sets
171that parameter in the created frame to its value in the selected 180the value of that parameter in the created frame to its value in the
172frame. 181selected frame.
173@end defvar 182@end defvar
174 183
184
175@node Multiple Terminals 185@node Multiple Terminals
176@section Multiple Terminals 186@section Multiple Terminals
177@cindex multiple terminals 187@cindex multiple terminals
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 441fda5d825..af646ce40f4 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -1885,8 +1885,8 @@ one of these functions; the arrival of the specified time will not
1885cause anything special to happen. 1885cause anything special to happen.
1886@end defun 1886@end defun
1887 1887
1888@findex timer-list 1888@findex list-timers
1889The @code{timer-list} command lists all the currently active timers. 1889The @code{list-timers} command lists all the currently active timers.
1890There's only one command available in the buffer displayed: @kbd{c} 1890There's only one command available in the buffer displayed: @kbd{c}
1891(@code{timer-list-cancel}) that will cancel the timer on the line 1891(@code{timer-list-cancel}) that will cancel the timer on the line
1892under point. 1892under point.
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index 23961f99efd..219225d412b 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -824,8 +824,9 @@ to the produced string representations of the argument @var{objects}.
824@end defun 824@end defun
825 825
826@defun format-message string &rest objects 826@defun format-message string &rest objects
827@cindex curved quotes 827@cindex curved quotes, in formatted messages
828@cindex curly quotes 828@cindex curly quotes, in formatted messages
829@cindex @code{text-quoting-style}, and formatting messages
829This function acts like @code{format}, except it also converts any 830This function acts like @code{format}, except it also converts any
830grave accents (@t{`}) and apostrophes (@t{'}) in @var{string} as per the 831grave accents (@t{`}) and apostrophes (@t{'}) in @var{string} as per the
831value of @code{text-quoting-style}. 832value of @code{text-quoting-style}.
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index a7d10797cd0..baa3c708e90 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -54,6 +54,8 @@ the character after point.
54* Registers:: How registers are implemented. Accessing the text or 54* Registers:: How registers are implemented. Accessing the text or
55 position stored in a register. 55 position stored in a register.
56* Transposition:: Swapping two portions of a buffer. 56* Transposition:: Swapping two portions of a buffer.
57* Replacing:: Replacing the text of one buffer with the text
58 of another buffer.
57* Decompression:: Dealing with compressed data. 59* Decompression:: Dealing with compressed data.
58* Base 64:: Conversion to or from base 64 encoding. 60* Base 64:: Conversion to or from base 64 encoding.
59* Checksum/Hash:: Computing cryptographic hashes. 61* Checksum/Hash:: Computing cryptographic hashes.
@@ -4328,6 +4330,28 @@ is non-@code{nil}, @code{transpose-regions} does not do this---it leaves
4328all markers unrelocated. 4330all markers unrelocated.
4329@end defun 4331@end defun
4330 4332
4333@node Replacing
4334@section Replacing Buffer Text
4335
4336 You can use the following function to replace the text of one buffer
4337with the text of another buffer:
4338
4339@deffn Command replace-buffer-contents source
4340This function replaces the accessible portion of the current buffer
4341with the accessible portion of the buffer @var{source}. @var{source}
4342may either be a buffer object or the name of a buffer. When
4343@code{replace-buffer-contents} succeeds, the text of the accessible
4344portion of the current buffer will be equal to the text of the
4345accessible portion of the @var{source} buffer. This function attempts
4346to keep point, markers, text properties, and overlays in the current
4347buffer intact. One potential case where this behavior is useful is
4348external code formatting programs: they typically write the
4349reformatted text into a temporary buffer or file, and using
4350@code{delete-region} and @code{insert-buffer-substring} would destroy
4351these properties. However, the latter combination is typically
4352faster. @xref{Deletion}, and @ref{Insertion}.
4353@end deffn
4354
4331@node Decompression 4355@node Decompression
4332@section Dealing With Compressed Data 4356@section Dealing With Compressed Data
4333 4357
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index bed3bed95bd..17fd4a1027e 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -68,10 +68,13 @@ costs.}. Use two hyphens to separate prefix and name if the symbol is
68not meant to be used by other packages. 68not meant to be used by other packages.
69 69
70Occasionally, for a command name intended for users to use, it is more 70Occasionally, for a command name intended for users to use, it is more
71convenient if some words come before the package's name prefix. And 71convenient if some words come before the package's name prefix. For
72constructs that define functions, variables, etc., work better if they 72example, it is our convention to have commands that list objects named
73start with @samp{defun} or @samp{defvar}, so put the name prefix later 73as @samp{list-@var{something}}, e.g., a package called @samp{frob}
74on in the name. 74could have a command @samp{list-frobs}, when its other global symbols
75begin with @samp{frob-}. Also, constructs that define functions,
76variables, etc., work better if they start with @samp{defun} or
77@samp{defvar}, so put the name prefix later on in the name.
75 78
76This recommendation applies even to names for traditional Lisp 79This recommendation applies even to names for traditional Lisp
77primitives that are not primitives in Emacs Lisp---such as 80primitives that are not primitives in Emacs Lisp---such as
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index a774790c511..9bd75b91e46 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,7 +3,7 @@
3% Load plain if necessary, i.e., if running under initex. 3% Load plain if necessary, i.e., if running under initex.
4\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi 4\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
5% 5%
6\def\texinfoversion{2017-08-23.19} 6\def\texinfoversion{2017-09-16.10}
7% 7%
8% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, 8% Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
9% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 9% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
@@ -21,7 +21,7 @@
21% General Public License for more details. 21% General Public License for more details.
22% 22%
23% You should have received a copy of the GNU General Public License 23% You should have received a copy of the GNU General Public License
24% along with this program. If not, see <http://www.gnu.org/licenses/>. 24% along with this program. If not, see <https://www.gnu.org/licenses/>.
25% 25%
26% As a special exception, when this file is read by TeX when processing 26% As a special exception, when this file is read by TeX when processing
27% a Texinfo source document, you may use the result without 27% a Texinfo source document, you may use the result without
@@ -30,9 +30,9 @@
30% 30%
31% Please try the latest version of texinfo.tex before submitting bug 31% Please try the latest version of texinfo.tex before submitting bug
32% reports; you can get the latest version from: 32% reports; you can get the latest version from:
33% http://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or 33% https://ftp.gnu.org/gnu/texinfo/ (the Texinfo release area), or
34% http://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or 34% https://ftpmirror.gnu.org/texinfo/ (same, via a mirror), or
35% http://www.gnu.org/software/texinfo/ (the Texinfo home page) 35% https://www.gnu.org/software/texinfo/ (the Texinfo home page)
36% The texinfo.tex in any given distribution could well be out 36% The texinfo.tex in any given distribution could well be out
37% of date, so if that's what you're using, please check. 37% of date, so if that's what you're using, please check.
38% 38%
@@ -56,7 +56,7 @@
56% extent. You can get the existing language-specific files from the 56% extent. You can get the existing language-specific files from the
57% full Texinfo distribution. 57% full Texinfo distribution.
58% 58%
59% The GNU Texinfo home page is http://www.gnu.org/software/texinfo. 59% The GNU Texinfo home page is https://www.gnu.org/software/texinfo.
60 60
61 61
62\message{Loading texinfo [version \texinfoversion]:} 62\message{Loading texinfo [version \texinfoversion]:}
@@ -9446,7 +9446,7 @@ end
9446\newif\ifwarnednoepsf 9446\newif\ifwarnednoepsf
9447\newhelp\noepsfhelp{epsf.tex must be installed for images to 9447\newhelp\noepsfhelp{epsf.tex must be installed for images to
9448 work. It is also included in the Texinfo distribution, or you can get 9448 work. It is also included in the Texinfo distribution, or you can get
9449 it from ftp://tug.org/tex/epsf.tex.} 9449 it from https://ctan.org/texarchive/macros/texinfo/texinfo/doc/epsf.tex.}
9450% 9450%
9451\def\image#1{% 9451\def\image#1{%
9452 \ifx\epsfbox\thisisundefined 9452 \ifx\epsfbox\thisisundefined
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 7e8ce75f2de..6478479c38d 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3043,6 +3043,14 @@ Disable version control to avoid delays:
3043@end group 3043@end group
3044@end lisp 3044@end lisp
3045 3045
3046If this is too radical, because you want to use version control
3047remotely, trim @code{vc-handled-backends} to just those you care
3048about, for example:
3049
3050@lisp
3051(setq vc-handled-backends '(SVN Git))
3052@end lisp
3053
3046Disable excessive traces. Set @code{tramp-verbose} to 3 or lower, 3054Disable excessive traces. Set @code{tramp-verbose} to 3 or lower,
3047default being 3. Increase trace levels temporarily when hunting for 3055default being 3. Increase trace levels temporarily when hunting for
3048bugs. 3056bugs.
diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi
index 5d9dcc5635d..5151ed5354c 100644
--- a/doc/misc/trampver.texi
+++ b/doc/misc/trampver.texi
@@ -8,7 +8,7 @@
8@c In the Tramp GIT, the version number is auto-frobbed from 8@c In the Tramp GIT, the version number is auto-frobbed from
9@c configure.ac, so you should edit that file and run 9@c configure.ac, so you should edit that file and run
10@c "autoconf && ./configure" to change the version number. 10@c "autoconf && ./configure" to change the version number.
11@set trampver 2.3.3-pre 11@set trampver 2.3.3.26.1
12 12
13@c Other flags from configuration 13@c Other flags from configuration
14@set instprefix /usr/local 14@set instprefix /usr/local
diff --git a/etc/NEWS b/etc/NEWS
index a042ce92aff..1b5ae658f6c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -117,6 +117,11 @@ The effect is similar to that of "toolBar" resource on the tool bar.
117 117
118* Changes in Emacs 26.1 118* Changes in Emacs 26.1
119 119
120+++
121** Option 'buffer-offer-save' can be set to new value, 'always'. When
122 set to 'always', the command `save-some-buffers' will always offer
123 this buffer for saving.
124
120** Security vulnerability related to Enriched Text mode is removed. 125** Security vulnerability related to Enriched Text mode is removed.
121 126
122+++ 127+++
@@ -144,8 +149,7 @@ init file:
144'save-buffer' process. Previously, saving a buffer that was not 149'save-buffer' process. Previously, saving a buffer that was not
145visiting a file would always prompt for a file name. Now it only does 150visiting a file would always prompt for a file name. Now it only does
146so if 'write-contents-functions' is nil (or all its functions return 151so if 'write-contents-functions' is nil (or all its functions return
147nil). A non-nil buffer-local value for this variable is sufficient 152nil).
148for 'save-some-buffers' to consider the buffer for saving.
149 153
150--- 154---
151** New variable 'executable-prefix-env' for inserting magic signatures. 155** New variable 'executable-prefix-env' for inserting magic signatures.
@@ -367,7 +371,7 @@ see the node "Connection Local Variables" in the ELisp manual.
367puny.el library, so that one can visit Web sites with non-ASCII URLs. 371puny.el library, so that one can visit Web sites with non-ASCII URLs.
368 372
369+++ 373+++
370** The new 'timer-list' command lists all active timers in a buffer, 374** The new 'list-timers' command lists all active timers in a buffer,
371where you can cancel them with the 'c' command. 375where you can cancel them with the 'c' command.
372 376
373+++ 377+++
@@ -578,7 +582,6 @@ Negative prefix arg flips the direction of selection. Also,
578defun are selected unless they are separated from the defun by a blank 582defun are selected unless they are separated from the defun by a blank
579line. 583line.
580 584
581---
582** New command 'replace-buffer-contents'. 585** New command 'replace-buffer-contents'.
583This command replaces the contents of the accessible portion of the 586This command replaces the contents of the accessible portion of the
584current buffer with the contents of the accessible portion of a 587current buffer with the contents of the accessible portion of a
@@ -701,6 +704,12 @@ method is an NNTP select method.
701*** A new command for sorting articles by readedness marks has been 704*** A new command for sorting articles by readedness marks has been
702added: 'C-c C-s C-m C-m'. 705added: 'C-c C-s C-m C-m'.
703 706
707+++
708
709*** In message-citation-line-format the %Z format is now the time zone name
710instead of the numeric form. The %z format continues to be the
711numeric form. The new behavior is compatible with format-time-string.
712
704** Ibuffer 713** Ibuffer
705 714
706--- 715---
@@ -1344,6 +1353,12 @@ non-nil, but the code returned the list in the increasing order of
1344priority instead. Now the code does what the documentation says it 1353priority instead. Now the code does what the documentation says it
1345should do. 1354should do.
1346 1355
1356---
1357** 'eldoc-message' only accepts one argument now. Programs that
1358called it with multiple arguments before should pass them through
1359'format' first. Even that is discouraged: for ElDoc support, you
1360should set 'eldoc-documentation-function' instead of calling
1361'eldoc-message' directly.
1347 1362
1348* Lisp Changes in Emacs 26.1 1363* Lisp Changes in Emacs 26.1
1349 1364
@@ -1813,6 +1828,13 @@ can be replicated simply by setting 'comment-auto-fill-only-comments'.
1813** New pcase pattern 'rx' to match against a rx-style regular expression. 1828** New pcase pattern 'rx' to match against a rx-style regular expression.
1814For details, see the doc string of 'rx--pcase-macroexpander'. 1829For details, see the doc string of 'rx--pcase-macroexpander'.
1815 1830
1831---
1832** New functions to set region from secondary selection and vice versa.
1833The new functions 'secondary-selection-to-region' and
1834'secondary-selection-from-region' let you set the beginning and the
1835end of the region from those of the secondary selection and vise
1836versa.
1837
1816 1838
1817* Changes in Emacs 26.1 on Non-Free Operating Systems 1839* Changes in Emacs 26.1 on Non-Free Operating Systems
1818 1840
@@ -1876,6 +1898,12 @@ of frame decorations on macOS 10.9+.
1876--- 1898---
1877** 'process-attributes' on Darwin systems now returns more information. 1899** 'process-attributes' on Darwin systems now returns more information.
1878 1900
1901---
1902** Mousewheel and trackpad scrolling on macOS 10.7+ now behaves more
1903like the macOS default. The new variables 'ns-mwheel-line-height',
1904'ns-use-mwheel-acceleration' and 'ns-use-mwheel-momentum' can be used
1905to customize the behavior.
1906
1879 1907
1880---------------------------------------------------------------------- 1908----------------------------------------------------------------------
1881This file is part of GNU Emacs. 1909This file is part of GNU Emacs.
diff --git a/lib-src/etags.c b/lib-src/etags.c
index 4000f47a414..009cba528d7 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -7068,14 +7068,16 @@ etags_mktmp (void)
7068 errno = temp_errno; 7068 errno = temp_errno;
7069 templt = NULL; 7069 templt = NULL;
7070 } 7070 }
7071
7072#if defined (DOS_NT) 7071#if defined (DOS_NT)
7073 /* The file name will be used in shell redirection, so it needs to have 7072 else
7074 DOS-style backslashes, or else the Windows shell will barf. */ 7073 {
7075 char *p; 7074 /* The file name will be used in shell redirection, so it needs to have
7076 for (p = templt; *p; p++) 7075 DOS-style backslashes, or else the Windows shell will barf. */
7077 if (*p == '/') 7076 char *p;
7078 *p = '\\'; 7077 for (p = templt; *p; p++)
7078 if (*p == '/')
7079 *p = '\\';
7080 }
7079#endif 7081#endif
7080 7082
7081 return templt; 7083 return templt;
diff --git a/lib/allocator.h b/lib/allocator.h
index 2ecbf1a3795..8f79d7435c3 100644
--- a/lib/allocator.h
+++ b/lib/allocator.h
@@ -29,7 +29,7 @@ struct allocator
29 /* Do not use GCC attributes such as __attribute__ ((malloc)) with 29 /* Do not use GCC attributes such as __attribute__ ((malloc)) with
30 the function types pointed at by these members, because these 30 the function types pointed at by these members, because these
31 attributes do not work with pointers to functions. See 31 attributes do not work with pointers to functions. See
32 <http://lists.gnu.org/archive/html/bug-gnulib/2011-04/msg00007.html>. */ 32 <https://lists.gnu.org/archive/html/bug-gnulib/2011-04/msg00007.html>. */
33 33
34 /* Call ALLOCATE to allocate memory, like 'malloc'. On failure ALLOCATE 34 /* Call ALLOCATE to allocate memory, like 'malloc'. On failure ALLOCATE
35 should return NULL, though not necessarily set errno. When given 35 should return NULL, though not necessarily set errno. When given
diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h
index 1b60e28e7ff..c8b3dc05110 100644
--- a/lib/count-leading-zeros.h
+++ b/lib/count-leading-zeros.h
@@ -70,7 +70,8 @@ _GL_INLINE_HEADER_BEGIN
70COUNT_LEADING_ZEROS_INLINE int 70COUNT_LEADING_ZEROS_INLINE int
71count_leading_zeros_32 (unsigned int x) 71count_leading_zeros_32 (unsigned int x)
72{ 72{
73 /* http://graphics.stanford.edu/~seander/bithacks.html */ 73 /* <https://github.com/gibsjose/BitHacks>
74 <http://www.fit.vutbr.cz/~ibarina/pub/bithacks.pdf> */
74 static const char de_Bruijn_lookup[32] = { 75 static const char de_Bruijn_lookup[32] = {
75 31, 22, 30, 21, 18, 10, 29, 2, 20, 17, 15, 13, 9, 6, 28, 1, 76 31, 22, 30, 21, 18, 10, 29, 2, 20, 17, 15, 13, 9, 6, 28, 1,
76 23, 19, 11, 3, 16, 14, 7, 24, 12, 4, 8, 25, 5, 26, 27, 0 77 23, 19, 11, 3, 16, 14, 7, 24, 12, 4, 8, 25, 5, 26, 27, 0
diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h
index be7131429c1..9f9f07f5a0d 100644
--- a/lib/count-trailing-zeros.h
+++ b/lib/count-trailing-zeros.h
@@ -68,7 +68,8 @@ _GL_INLINE_HEADER_BEGIN
68COUNT_TRAILING_ZEROS_INLINE int 68COUNT_TRAILING_ZEROS_INLINE int
69count_trailing_zeros_32 (unsigned int x) 69count_trailing_zeros_32 (unsigned int x)
70{ 70{
71 /* http://graphics.stanford.edu/~seander/bithacks.html */ 71 /* <https://github.com/gibsjose/BitHacks>
72 <http://www.fit.vutbr.cz/~ibarina/pub/bithacks.pdf> */
72 static const char de_Bruijn_lookup[32] = { 73 static const char de_Bruijn_lookup[32] = {
73 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8, 74 0, 1, 28, 2, 29, 14, 24, 3, 30, 22, 20, 15, 25, 17, 4, 8,
74 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9 75 31, 27, 13, 23, 21, 19, 16, 7, 26, 12, 18, 6, 11, 5, 10, 9
diff --git a/lib/dup2.c b/lib/dup2.c
index b89f83732fe..85c1a44401a 100644
--- a/lib/dup2.c
+++ b/lib/dup2.c
@@ -88,7 +88,7 @@ ms_windows_dup2 (int fd, int desired_fd)
88 } 88 }
89 89
90 /* Wine 1.0.1 return 0 when desired_fd is negative but not -1: 90 /* Wine 1.0.1 return 0 when desired_fd is negative but not -1:
91 http://bugs.winehq.org/show_bug.cgi?id=21289 */ 91 https://bugs.winehq.org/show_bug.cgi?id=21289 */
92 if (desired_fd < 0) 92 if (desired_fd < 0)
93 { 93 {
94 errno = EBADF; 94 errno = EBADF;
diff --git a/lib/filevercmp.c b/lib/filevercmp.c
index 56c9821e364..4026097b38e 100644
--- a/lib/filevercmp.c
+++ b/lib/filevercmp.c
@@ -79,7 +79,7 @@ order (unsigned char c)
79 specification can be found in the Debian Policy Manual in the 79 specification can be found in the Debian Policy Manual in the
80 section on the 'Version' control field. This version of the code 80 section on the 'Version' control field. This version of the code
81 implements that from s5.6.12 of Debian Policy v3.8.0.1 81 implements that from s5.6.12 of Debian Policy v3.8.0.1
82 http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version */ 82 https://www.debian.org/doc/debian-policy/ch-controlfields.html#s-f-Version */
83static int _GL_ATTRIBUTE_PURE 83static int _GL_ATTRIBUTE_PURE
84verrevcmp (const char *s1, size_t s1_len, const char *s2, size_t s2_len) 84verrevcmp (const char *s1, size_t s1_len, const char *s2, size_t s2_len)
85{ 85{
diff --git a/lib/fstatat.c b/lib/fstatat.c
index d09add037fa..67e48d95d71 100644
--- a/lib/fstatat.c
+++ b/lib/fstatat.c
@@ -111,7 +111,7 @@ stat_func (char const *name, struct stat *st)
111# endif 111# endif
112 112
113/* Replacement for Solaris' function by the same name. 113/* Replacement for Solaris' function by the same name.
114 <http://www.google.com/search?q=fstatat+site:docs.sun.com> 114 <https://www.google.com/search?q=fstatat+site:docs.oracle.com>
115 First, try to simulate it via l?stat ("/proc/self/fd/FD/FILE"). 115 First, try to simulate it via l?stat ("/proc/self/fd/FD/FILE").
116 Failing that, simulate it via save_cwd/fchdir/(stat|lstat)/restore_cwd. 116 Failing that, simulate it via save_cwd/fchdir/(stat|lstat)/restore_cwd.
117 If either the save_cwd or the restore_cwd fails (relatively unlikely), 117 If either the save_cwd or the restore_cwd fails (relatively unlikely),
diff --git a/lib/fsync.c b/lib/fsync.c
index a52e6642f91..c25f1db6575 100644
--- a/lib/fsync.c
+++ b/lib/fsync.c
@@ -2,8 +2,8 @@
2 cross-compilers like MinGW. 2 cross-compilers like MinGW.
3 3
4 This is derived from sqlite3 sources. 4 This is derived from sqlite3 sources.
5 http://www.sqlite.org/cvstrac/rlog?f=sqlite/src/os_win.c 5 https://www.sqlite.org/src/finfo?name=src/os_win.c
6 http://www.sqlite.org/copyright.html 6 https://www.sqlite.org/copyright.html
7 7
8 Written by Richard W.M. Jones <rjones.at.redhat.com> 8 Written by Richard W.M. Jones <rjones.at.redhat.com>
9 9
diff --git a/lib/ftoastr.c b/lib/ftoastr.c
index 029e797b796..bcc79f03673 100644
--- a/lib/ftoastr.c
+++ b/lib/ftoastr.c
@@ -108,7 +108,7 @@ FTOASTR (char *buf, size_t bufsize, int flags, int width, FLOAT x)
108 Andrysco M, Jhala R, Lerner S. Printing floating-point numbers: 108 Andrysco M, Jhala R, Lerner S. Printing floating-point numbers:
109 a faster, always correct method. ACM SIGPLAN notices - POPL '16. 109 a faster, always correct method. ACM SIGPLAN notices - POPL '16.
110 2016;51(1):555-67 <http://dx.doi.org/10.1145/2914770.2837654>; draft at 110 2016;51(1):555-67 <http://dx.doi.org/10.1145/2914770.2837654>; draft at
111 <http://cseweb.ucsd.edu/~lerner/papers/fp-printing-popl16.pdf>. */ 111 <https://cseweb.ucsd.edu/~lerner/papers/fp-printing-popl16.pdf>. */
112 112
113 PROMOTED_FLOAT promoted_x = x; 113 PROMOTED_FLOAT promoted_x = x;
114 char format[sizeof "%-+ 0*.*Lg"]; 114 char format[sizeof "%-+ 0*.*Lg"];
diff --git a/lib/ftoastr.h b/lib/ftoastr.h
index 3ee05a30335..f73712c9415 100644
--- a/lib/ftoastr.h
+++ b/lib/ftoastr.h
@@ -96,7 +96,7 @@ enum
96 DIG digits. For why the "+ 1" is needed, see "Binary to Decimal 96 DIG digits. For why the "+ 1" is needed, see "Binary to Decimal
97 Conversion" in David Goldberg's paper "What Every Computer 97 Conversion" in David Goldberg's paper "What Every Computer
98 Scientist Should Know About Floating-Point Arithmetic" 98 Scientist Should Know About Floating-Point Arithmetic"
99 <http://docs.oracle.com/cd/E19957-01/806-3568/ncg_goldberg.html>. */ 99 <https://docs.oracle.com/cd/E19957-01/806-3568/ncg_goldberg.html>. */
100# define _GL_FLOAT_PREC_BOUND(dig) \ 100# define _GL_FLOAT_PREC_BOUND(dig) \
101 (INT_BITS_STRLEN_BOUND ((dig) * _GL_FLOAT_DIG_BITS_BOUND) + 1) 101 (INT_BITS_STRLEN_BOUND ((dig) * _GL_FLOAT_DIG_BITS_BOUND) + 1)
102 102
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 9500871b162..d8afec40bc6 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -558,6 +558,7 @@ LIBGPM = @LIBGPM@
558LIBHESIOD = @LIBHESIOD@ 558LIBHESIOD = @LIBHESIOD@
559LIBINTL = @LIBINTL@ 559LIBINTL = @LIBINTL@
560LIBJPEG = @LIBJPEG@ 560LIBJPEG = @LIBJPEG@
561LIBLCMS2 = @LIBLCMS2@
561LIBMODULES = @LIBMODULES@ 562LIBMODULES = @LIBMODULES@
562LIBOBJS = @LIBOBJS@ 563LIBOBJS = @LIBOBJS@
563LIBOTF_CFLAGS = @LIBOTF_CFLAGS@ 564LIBOTF_CFLAGS = @LIBOTF_CFLAGS@
diff --git a/lib/intprops.h b/lib/intprops.h
index 400ba5b9123..a34e81c7b5e 100644
--- a/lib/intprops.h
+++ b/lib/intprops.h
@@ -26,7 +26,7 @@
26#define _GL_INT_CONVERT(e, v) (0 * (e) + (v)) 26#define _GL_INT_CONVERT(e, v) (0 * (e) + (v))
27 27
28/* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see 28/* Act like _GL_INT_CONVERT (E, -V) but work around a bug in IRIX 6.5 cc; see
29 <http://lists.gnu.org/archive/html/bug-gnulib/2011-05/msg00406.html>. */ 29 <https://lists.gnu.org/archive/html/bug-gnulib/2011-05/msg00406.html>. */
30#define _GL_INT_NEGATE_CONVERT(e, v) (0 * (e) - (v)) 30#define _GL_INT_NEGATE_CONVERT(e, v) (0 * (e) - (v))
31 31
32/* The extra casts in the following macros work around compiler bugs, 32/* The extra casts in the following macros work around compiler bugs,
@@ -179,7 +179,7 @@
179/* Return 1 if A * B would overflow in [MIN,MAX] arithmetic. 179/* Return 1 if A * B would overflow in [MIN,MAX] arithmetic.
180 See above for restrictions. Avoid && and || as they tickle 180 See above for restrictions. Avoid && and || as they tickle
181 bugs in Sun C 5.11 2010/08/13 and other compilers; see 181 bugs in Sun C 5.11 2010/08/13 and other compilers; see
182 <http://lists.gnu.org/archive/html/bug-gnulib/2011-05/msg00401.html>. */ 182 <https://lists.gnu.org/archive/html/bug-gnulib/2011-05/msg00401.html>. */
183#define INT_MULTIPLY_RANGE_OVERFLOW(a, b, min, max) \ 183#define INT_MULTIPLY_RANGE_OVERFLOW(a, b, min, max) \
184 ((b) < 0 \ 184 ((b) < 0 \
185 ? ((a) < 0 \ 185 ? ((a) < 0 \
@@ -443,7 +443,7 @@
443 implementation-defined result or signal for values outside T's 443 implementation-defined result or signal for values outside T's
444 range. However, code that works around this theoretical problem 444 range. However, code that works around this theoretical problem
445 runs afoul of a compiler bug in Oracle Studio 12.3 x86. See: 445 runs afoul of a compiler bug in Oracle Studio 12.3 x86. See:
446 http://lists.gnu.org/archive/html/bug-gnulib/2017-04/msg00049.html 446 https://lists.gnu.org/archive/html/bug-gnulib/2017-04/msg00049.html
447 As the compiler bug is real, don't try to work around the 447 As the compiler bug is real, don't try to work around the
448 theoretical problem. */ 448 theoretical problem. */
449 449
diff --git a/lib/signal.in.h b/lib/signal.in.h
index 1d8ebfa57e7..9c32b14962f 100644
--- a/lib/signal.in.h
+++ b/lib/signal.in.h
@@ -200,7 +200,7 @@ typedef int verify_NSIG_constraint[NSIG <= 32 ? 1 : -1];
200/* When also using extern inline, suppress the use of static inline in 200/* When also using extern inline, suppress the use of static inline in
201 standard headers of problematic Apple configurations, as Libc at 201 standard headers of problematic Apple configurations, as Libc at
202 least through Libc-825.26 (2013-04-09) mishandles it; see, e.g., 202 least through Libc-825.26 (2013-04-09) mishandles it; see, e.g.,
203 <http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html>. 203 <https://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html>.
204 Perhaps Apple will fix this some day. */ 204 Perhaps Apple will fix this some day. */
205#if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \ 205#if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \
206 && (defined __i386__ || defined __x86_64__)) 206 && (defined __i386__ || defined __x86_64__))
diff --git a/lib/stdio-impl.h b/lib/stdio-impl.h
index 0d606c19c84..8960333687e 100644
--- a/lib/stdio-impl.h
+++ b/lib/stdio-impl.h
@@ -32,7 +32,7 @@
32 /* FreeBSD, NetBSD, OpenBSD, DragonFly, Mac OS X, Cygwin, Minix 3, Android */ 32 /* FreeBSD, NetBSD, OpenBSD, DragonFly, Mac OS X, Cygwin, Minix 3, Android */
33 33
34# if defined __DragonFly__ /* DragonFly */ 34# if defined __DragonFly__ /* DragonFly */
35 /* See <http://www.dragonflybsd.org/cvsweb/src/lib/libc/stdio/priv_stdio.h?rev=HEAD&content-type=text/x-cvsweb-markup>. */ 35 /* See <https://gitweb.dragonflybsd.org/dragonfly.git/blob_plain/HEAD:/lib/libc/stdio/priv_stdio.h>. */
36# define fp_ ((struct { struct __FILE_public pub; \ 36# define fp_ ((struct { struct __FILE_public pub; \
37 struct { unsigned char *_base; int _size; } _bf; \ 37 struct { unsigned char *_base; int _size; } _bf; \
38 void *cookie; \ 38 void *cookie; \
@@ -49,7 +49,7 @@
49 fpos_t _offset; \ 49 fpos_t _offset; \
50 /* More fields, not relevant here. */ \ 50 /* More fields, not relevant here. */ \
51 } *) fp) 51 } *) fp)
52 /* See <http://www.dragonflybsd.org/cvsweb/src/include/stdio.h?rev=HEAD&content-type=text/x-cvsweb-markup>. */ 52 /* See <https://gitweb.dragonflybsd.org/dragonfly.git/blob_plain/HEAD:/include/stdio.h>. */
53# define _p pub._p 53# define _p pub._p
54# define _flags pub._flags 54# define _flags pub._flags
55# define _r pub._r 55# define _r pub._r
@@ -60,7 +60,7 @@
60 60
61# if (defined __NetBSD__ && __NetBSD_Version__ >= 105270000) || defined __OpenBSD__ || defined __minix || defined __ANDROID__ /* NetBSD >= 1.5ZA, OpenBSD, Minix 3, Android */ 61# if (defined __NetBSD__ && __NetBSD_Version__ >= 105270000) || defined __OpenBSD__ || defined __minix || defined __ANDROID__ /* NetBSD >= 1.5ZA, OpenBSD, Minix 3, Android */
62 /* See <http://cvsweb.netbsd.org/bsdweb.cgi/src/lib/libc/stdio/fileext.h?rev=HEAD&content-type=text/x-cvsweb-markup> 62 /* See <http://cvsweb.netbsd.org/bsdweb.cgi/src/lib/libc/stdio/fileext.h?rev=HEAD&content-type=text/x-cvsweb-markup>
63 and <http://www.openbsd.org/cgi-bin/cvsweb/src/lib/libc/stdio/fileext.h?rev=HEAD&content-type=text/x-cvsweb-markup> */ 63 and <https://cvsweb.openbsd.org/cgi-bin/cvsweb/src/lib/libc/stdio/fileext.h?rev=HEAD&content-type=text/x-cvsweb-markup> */
64 struct __sfileext 64 struct __sfileext
65 { 65 {
66 struct __sbuf _ub; /* ungetc buffer */ 66 struct __sbuf _ub; /* ungetc buffer */
@@ -81,7 +81,7 @@
81#ifdef __TANDEM /* NonStop Kernel */ 81#ifdef __TANDEM /* NonStop Kernel */
82# ifndef _IOERR 82# ifndef _IOERR
83/* These values were determined by the program 'stdioext-flags' at 83/* These values were determined by the program 'stdioext-flags' at
84 <http://lists.gnu.org/archive/html/bug-gnulib/2010-12/msg00165.html>. */ 84 <https://lists.gnu.org/archive/html/bug-gnulib/2010-12/msg00165.html>. */
85# define _IOERR 0x40 85# define _IOERR 0x40
86# define _IOREAD 0x80 86# define _IOREAD 0x80
87# define _IOWRT 0x4 87# define _IOWRT 0x4
@@ -132,7 +132,7 @@ struct _gl_real_FILE
132# define fp_ ((struct _gl_real_FILE *) fp) 132# define fp_ ((struct _gl_real_FILE *) fp)
133 133
134/* These values were determined by a program similar to the one at 134/* These values were determined by a program similar to the one at
135 <http://lists.gnu.org/archive/html/bug-gnulib/2010-12/msg00165.html>. */ 135 <https://lists.gnu.org/archive/html/bug-gnulib/2010-12/msg00165.html>. */
136# define _IOREAD 0x1 136# define _IOREAD 0x1
137# define _IOWRT 0x2 137# define _IOWRT 0x2
138# define _IORW 0x4 138# define _IORW 0x4
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
index 5cf31319d9f..066e08eba9a 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -152,7 +152,7 @@
152/* When also using extern inline, suppress the use of static inline in 152/* When also using extern inline, suppress the use of static inline in
153 standard headers of problematic Apple configurations, as Libc at 153 standard headers of problematic Apple configurations, as Libc at
154 least through Libc-825.26 (2013-04-09) mishandles it; see, e.g., 154 least through Libc-825.26 (2013-04-09) mishandles it; see, e.g.,
155 <http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html>. 155 <https://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html>.
156 Perhaps Apple will fix this some day. */ 156 Perhaps Apple will fix this some day. */
157#if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \ 157#if (defined _GL_EXTERN_INLINE_IN_USE && defined __APPLE__ \
158 && defined __GNUC__ && defined __STDC__) 158 && defined __GNUC__ && defined __STDC__)
@@ -610,7 +610,7 @@ _GL_CXXALIAS_SYS (fwrite, size_t,
610 (const void *ptr, size_t s, size_t n, FILE *stream)); 610 (const void *ptr, size_t s, size_t n, FILE *stream));
611 611
612/* Work around bug 11959 when fortifying glibc 2.4 through 2.15 612/* Work around bug 11959 when fortifying glibc 2.4 through 2.15
613 <http://sources.redhat.com/bugzilla/show_bug.cgi?id=11959>, 613 <https://sourceware.org/bugzilla/show_bug.cgi?id=11959>,
614 which sometimes causes an unwanted diagnostic for fwrite calls. 614 which sometimes causes an unwanted diagnostic for fwrite calls.
615 This affects only function declaration attributes under certain 615 This affects only function declaration attributes under certain
616 versions of gcc and clang, and is not needed for C++. */ 616 versions of gcc and clang, and is not needed for C++. */
diff --git a/lib/unistd.in.h b/lib/unistd.in.h
index 8a383b3d016..c1dd07ff8cd 100644
--- a/lib/unistd.in.h
+++ b/lib/unistd.in.h
@@ -379,7 +379,7 @@ _GL_WARN_ON_USE (dup2, "dup2 is unportable - "
379 Close NEWFD first if it is open. 379 Close NEWFD first if it is open.
380 Return newfd if successful, otherwise -1 and errno set. 380 Return newfd if successful, otherwise -1 and errno set.
381 See the Linux man page at 381 See the Linux man page at
382 <http://www.kernel.org/doc/man-pages/online/pages/man2/dup3.2.html>. */ 382 <https://www.kernel.org/doc/man-pages/online/pages/man2/dup3.2.html>. */
383# if @HAVE_DUP3@ 383# if @HAVE_DUP3@
384# if !(defined __cplusplus && defined GNULIB_NAMESPACE) 384# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
385# define dup3 rpl_dup3 385# define dup3 rpl_dup3
@@ -1149,7 +1149,7 @@ _GL_WARN_ON_USE (pipe, "pipe is unportable - "
1149 Store the read-end as fd[0] and the write-end as fd[1]. 1149 Store the read-end as fd[0] and the write-end as fd[1].
1150 Return 0 upon success, or -1 with errno set upon failure. 1150 Return 0 upon success, or -1 with errno set upon failure.
1151 See also the Linux man page at 1151 See also the Linux man page at
1152 <http://www.kernel.org/doc/man-pages/online/pages/man2/pipe2.2.html>. */ 1152 <https://www.kernel.org/doc/man-pages/online/pages/man2/pipe2.2.html>. */
1153# if @HAVE_PIPE2@ 1153# if @HAVE_PIPE2@
1154# if !(defined __cplusplus && defined GNULIB_NAMESPACE) 1154# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
1155# define pipe2 rpl_pipe2 1155# define pipe2 rpl_pipe2
diff --git a/lib/utimens.c b/lib/utimens.c
index a5716ac8105..55545e8ce9b 100644
--- a/lib/utimens.c
+++ b/lib/utimens.c
@@ -196,7 +196,7 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2])
196 /* Some Linux-based NFS clients are buggy, and mishandle timestamps 196 /* Some Linux-based NFS clients are buggy, and mishandle timestamps
197 of files in NFS file systems in some cases. We have no 197 of files in NFS file systems in some cases. We have no
198 configure-time test for this, but please see 198 configure-time test for this, but please see
199 <http://bugs.gentoo.org/show_bug.cgi?id=132673> for references to 199 <https://bugs.gentoo.org/show_bug.cgi?id=132673> for references to
200 some of the problems with Linux 2.6.16. If this affects you, 200 some of the problems with Linux 2.6.16. If this affects you,
201 compile with -DHAVE_BUGGY_NFS_TIME_STAMPS; this is reported to 201 compile with -DHAVE_BUGGY_NFS_TIME_STAMPS; this is reported to
202 help in some cases, albeit at a cost in performance. But you 202 help in some cases, albeit at a cost in performance. But you
@@ -250,8 +250,8 @@ fdutimens (int fd, char const *file, struct timespec const timespec[2])
250 result = utimensat (AT_FDCWD, file, ts, 0); 250 result = utimensat (AT_FDCWD, file, ts, 0);
251# ifdef __linux__ 251# ifdef __linux__
252 /* Work around a kernel bug: 252 /* Work around a kernel bug:
253 http://bugzilla.redhat.com/442352 253 https://bugzilla.redhat.com/show_bug.cgi?id=442352
254 http://bugzilla.redhat.com/449910 254 https://bugzilla.redhat.com/show_bug.cgi?id=449910
255 It appears that utimensat can mistakenly return 280 rather 255 It appears that utimensat can mistakenly return 280 rather
256 than -1 upon ENOSYS failure. 256 than -1 upon ENOSYS failure.
257 FIXME: remove in 2010 or whenever the offending kernels 257 FIXME: remove in 2010 or whenever the offending kernels
@@ -566,8 +566,8 @@ lutimens (char const *file, struct timespec const timespec[2])
566 result = utimensat (AT_FDCWD, file, ts, AT_SYMLINK_NOFOLLOW); 566 result = utimensat (AT_FDCWD, file, ts, AT_SYMLINK_NOFOLLOW);
567# ifdef __linux__ 567# ifdef __linux__
568 /* Work around a kernel bug: 568 /* Work around a kernel bug:
569 http://bugzilla.redhat.com/442352 569 https://bugzilla.redhat.com/show_bug.cgi?id=442352
570 http://bugzilla.redhat.com/449910 570 https://bugzilla.redhat.com/show_bug.cgi?id=449910
571 It appears that utimensat can mistakenly return 280 rather 571 It appears that utimensat can mistakenly return 280 rather
572 than -1 upon ENOSYS failure. 572 than -1 upon ENOSYS failure.
573 FIXME: remove in 2010 or whenever the offending kernels 573 FIXME: remove in 2010 or whenever the offending kernels
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
index 72db03e5e60..1d295606f23 100644
--- a/lisp/calendar/cal-tex.el
+++ b/lisp/calendar/cal-tex.el
@@ -266,7 +266,7 @@ specified in ARGS. When ARGS is omitted, by default the option
266\"12pt,a4paper\" is passed. When ARGS has any other value, then 266\"12pt,a4paper\" is passed. When ARGS has any other value, then
267no option is passed to the class. 267no option is passed to the class.
268 268
269Insert the \"\\usepacakge{geometry}\" directive when ARGS 269Insert the \"\\usepackage{geometry}\" directive when ARGS
270contains the \"landscape\" string." 270contains the \"landscape\" string."
271 (set-buffer (generate-new-buffer cal-tex-buffer)) 271 (set-buffer (generate-new-buffer cal-tex-buffer))
272 (save-match-data 272 (save-match-data
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index 6d9a7d9211a..71d46c11077 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -286,27 +286,60 @@ BUFFER defaults to current buffer. Does not modify BUFFER."
286 286
287 287
288(defmacro ert-with-message-capture (var &rest body) 288(defmacro ert-with-message-capture (var &rest body)
289 "Execute BODY while collecting anything written with `message' in VAR. 289 "Execute BODY while collecting messages in VAR.
290 290
291Capture all messages produced by `message' when it is called from 291Capture messages issued by Lisp code and concatenate them
292Lisp, and concatenate them separated by newlines into one string. 292separated by newlines into one string. This includes messages
293written by `message' as well as objects printed by `print',
294`prin1' and `princ' to the echo area. Messages issued from C
295code using the above mentioned functions will not be captured.
293 296
294This is useful for separating the issuance of messages by the 297This is useful for separating the issuance of messages by the
295code under test from the behavior of the *Messages* buffer." 298code under test from the behavior of the *Messages* buffer."
296 (declare (debug (symbolp body)) 299 (declare (debug (symbolp body))
297 (indent 1)) 300 (indent 1))
298 (let ((g-advice (gensym))) 301 (let ((g-message-advice (gensym))
302 (g-print-advice (gensym))
303 (g-collector (gensym)))
299 `(let* ((,var "") 304 `(let* ((,var "")
300 (,g-advice (lambda (func &rest args) 305 (,g-collector (lambda (msg) (setq ,var (concat ,var msg))))
301 (if (or (null args) (equal (car args) "")) 306 (,g-message-advice (ert--make-message-advice ,g-collector))
302 (apply func args) 307 (,g-print-advice (ert--make-print-advice ,g-collector)))
303 (let ((msg (apply #'format-message args))) 308 (advice-add 'message :around ,g-message-advice)
304 (setq ,var (concat ,var msg "\n")) 309 (advice-add 'prin1 :around ,g-print-advice)
305 (funcall func "%s" msg)))))) 310 (advice-add 'princ :around ,g-print-advice)
306 (advice-add 'message :around ,g-advice) 311 (advice-add 'print :around ,g-print-advice)
307 (unwind-protect 312 (unwind-protect
308 (progn ,@body) 313 (progn ,@body)
309 (advice-remove 'message ,g-advice))))) 314 (advice-remove 'print ,g-print-advice)
315 (advice-remove 'princ ,g-print-advice)
316 (advice-remove 'prin1 ,g-print-advice)
317 (advice-remove 'message ,g-message-advice)))))
318
319(defun ert--make-message-advice (collector)
320 "Create around advice for `message' for `ert-collect-messages'.
321COLLECTOR will be called with the message before it is passed
322to the real `message'."
323 (lambda (func &rest args)
324 (if (or (null args) (equal (car args) ""))
325 (apply func args)
326 (let ((msg (apply #'format-message args)))
327 (funcall collector (concat msg "\n"))
328 (funcall func "%s" msg)))))
329
330(defun ert--make-print-advice (collector)
331 "Create around advice for print functions for `ert-collect-messages'.
332The created advice function will just call the original function
333unless the output is going to the echo area (when PRINTCHARFUN is
334t or PRINTCHARFUN is nil and `standard-output' is t). If the
335output is destined for the echo area, the advice function will
336convert it to a string and pass it to COLLECTOR first."
337 (lambda (func object &optional printcharfun)
338 (if (not (eq t (or printcharfun standard-output)))
339 (funcall func object printcharfun)
340 (funcall collector (with-output-to-string
341 (funcall func object)))
342 (funcall func object printcharfun))))
310 343
311 344
312(provide 'ert-x) 345(provide 'ert-x)
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index d4276221ba5..83acbacb883 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -742,9 +742,8 @@ run. ARGS are the arguments to `debugger'."
742 ;; backtrace ready for printing is important for batch 742 ;; backtrace ready for printing is important for batch
743 ;; use. 743 ;; use.
744 ;; 744 ;;
745 ;; Grab the frames starting from `signal', frames below 745 ;; Grab the frames above the debugger.
746 ;; that are all from the debugger. 746 (backtrace (cdr (backtrace-frames debugger)))
747 (backtrace (backtrace-frames 'signal))
748 (infos (reverse ert--infos))) 747 (infos (reverse ert--infos)))
749 (setf (ert--test-execution-info-result info) 748 (setf (ert--test-execution-info-result info)
750 (cl-ecase type 749 (cl-ecase type
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 87c4782e217..da1e12b1408 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -1956,7 +1956,7 @@ E.g. provided via a file-local call to `smie-config-local'.")
1956(defvar smie-config--modefuns nil) 1956(defvar smie-config--modefuns nil)
1957 1957
1958(defun smie-config--setter (var value) 1958(defun smie-config--setter (var value)
1959 (setq-default var value) 1959 (set-default var value)
1960 (let ((old-modefuns smie-config--modefuns)) 1960 (let ((old-modefuns smie-config--modefuns))
1961 (setq smie-config--modefuns nil) 1961 (setq smie-config--modefuns nil)
1962 (pcase-dolist (`(,mode . ,rules) value) 1962 (pcase-dolist (`(,mode . ,rules) value)
@@ -1982,7 +1982,7 @@ value with which to replace it."
1982 ;; FIXME improve value-type. 1982 ;; FIXME improve value-type.
1983 :type '(choice (const nil) 1983 :type '(choice (const nil)
1984 (alist :key-type symbol)) 1984 (alist :key-type symbol))
1985 :initialize 'custom-initialize-default 1985 :initialize 'custom-initialize-set
1986 :set #'smie-config--setter) 1986 :set #'smie-config--setter)
1987 1987
1988(defun smie-config-local (rules) 1988(defun smie-config-local (rules)
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 077ad22c75d..edba6550fa2 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -128,7 +128,7 @@ binding value is nil. If all are non-nil, the value of THEN is
128returned, or the last form in ELSE is returned. 128returned, or the last form in ELSE is returned.
129 129
130Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds 130Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds
131SYMBOL to the value of VALUEFORM). An element can additionally 131SYMBOL to the value of VALUEFORM. An element can additionally
132be of the form (VALUEFORM), which is evaluated and checked for 132be of the form (VALUEFORM), which is evaluated and checked for
133nil; i.e. SYMBOL can be omitted if only the test result is of 133nil; i.e. SYMBOL can be omitted if only the test result is of
134interest." 134interest."
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index f6137837858..9eb6bde7454 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -381,10 +381,26 @@ This function should move the cursor back to some syntactically safe
381point (where the PPSS is equivalent to nil).") 381point (where the PPSS is equivalent to nil).")
382(make-obsolete-variable 'syntax-begin-function nil "25.1") 382(make-obsolete-variable 'syntax-begin-function nil "25.1")
383 383
384(defvar-local syntax-ppss-cache nil 384;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
385 "List of (POS . PPSS) pairs, in decreasing POS order.") 385;; Several caches.
386(defvar-local syntax-ppss-last nil 386;;
387 "Cache of (LAST-POS . LAST-PPSS).") 387;; Because `syntax-ppss' is equivalent to (parse-partial-sexp
388;; (POINT-MIN) x), we need either to empty the cache when we narrow
389;; the buffer, which is suboptimal, or we need to use several caches.
390;; We use two of them, one for widened buffer, and one for narrowing.
391;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
392
393(defvar-local syntax-ppss-wide nil
394 "Cons of two elements (LAST . CACHE).
395Where LAST is a pair (LAST-POS . LAST-PPS) caching the last invocation
396and CACHE is a list of (POS . PPSS) pairs, in decreasing POS order.
397These are valid when the buffer has no restriction.")
398
399(defvar-local syntax-ppss-narrow nil
400 "Same as `syntax-ppss-wide' but for a narrowed buffer.")
401
402(defvar-local syntax-ppss-narrow-start nil
403 "Start position of the narrowing for `syntax-ppss-narrow'.")
388 404
389(defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache) 405(defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache)
390(defun syntax-ppss-flush-cache (beg &rest ignored) 406(defun syntax-ppss-flush-cache (beg &rest ignored)
@@ -392,24 +408,29 @@ point (where the PPSS is equivalent to nil).")
392 ;; Set syntax-propertize to refontify anything past beg. 408 ;; Set syntax-propertize to refontify anything past beg.
393 (setq syntax-propertize--done (min beg syntax-propertize--done)) 409 (setq syntax-propertize--done (min beg syntax-propertize--done))
394 ;; Flush invalid cache entries. 410 ;; Flush invalid cache entries.
395 (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg)) 411 (dolist (cell (list syntax-ppss-wide syntax-ppss-narrow))
396 (setq syntax-ppss-cache (cdr syntax-ppss-cache))) 412 (pcase cell
397 ;; Throw away `last' value if made invalid. 413 (`(,last . ,cache)
398 (when (< beg (or (car syntax-ppss-last) 0)) 414 (while (and cache (> (caar cache) beg))
399 ;; If syntax-begin-function jumped to BEG, then the old state at BEG can 415 (setq cache (cdr cache)))
400 ;; depend on the text after BEG (which is presumably changed). So if 416 ;; Throw away `last' value if made invalid.
401 ;; BEG=(car (nth 10 syntax-ppss-last)) don't reuse that data because the 417 (when (< beg (or (car last) 0))
402 ;; assumed nil state at BEG may not be valid any more. 418 ;; If syntax-begin-function jumped to BEG, then the old state at BEG can
403 (if (<= beg (or (syntax-ppss-toplevel-pos (cdr syntax-ppss-last)) 419 ;; depend on the text after BEG (which is presumably changed). So if
404 (nth 3 syntax-ppss-last) 420 ;; BEG=(car (nth 10 syntax-ppss-last)) don't reuse that data because the
405 0)) 421 ;; assumed nil state at BEG may not be valid any more.
406 (setq syntax-ppss-last nil) 422 (if (<= beg (or (syntax-ppss-toplevel-pos (cdr last))
407 (setcar syntax-ppss-last nil))) 423 (nth 3 last)
408 ;; Unregister if there's no cache left. Sadly this doesn't work 424 0))
409 ;; because `before-change-functions' is temporarily bound to nil here. 425 (setq last nil)
410 ;; (unless syntax-ppss-cache 426 (setcar last nil)))
411 ;; (remove-hook 'before-change-functions 'syntax-ppss-flush-cache t)) 427 ;; Unregister if there's no cache left. Sadly this doesn't work
412 ) 428 ;; because `before-change-functions' is temporarily bound to nil here.
429 ;; (unless cache
430 ;; (remove-hook 'before-change-functions 'syntax-ppss-flush-cache t))
431 (setcar cell last)
432 (setcdr cell cache)))
433 ))
413 434
414(defvar syntax-ppss-stats 435(defvar syntax-ppss-stats
415 [(0 . 0.0) (0 . 0.0) (0 . 0.0) (0 . 0.0) (0 . 0.0) (1 . 2500.0)]) 436 [(0 . 0.0) (0 . 0.0) (0 . 0.0) (0 . 0.0) (0 . 0.0) (1 . 2500.0)])
@@ -423,6 +444,17 @@ point (where the PPSS is equivalent to nil).")
423(defvar-local syntax-ppss-table nil 444(defvar-local syntax-ppss-table nil
424 "Syntax-table to use during `syntax-ppss', if any.") 445 "Syntax-table to use during `syntax-ppss', if any.")
425 446
447(defun syntax-ppss--data ()
448 (if (eq (point-min) 1)
449 (progn
450 (unless syntax-ppss-wide
451 (setq syntax-ppss-wide (cons nil nil)))
452 syntax-ppss-wide)
453 (unless (eq syntax-ppss-narrow-start (point-min))
454 (setq syntax-ppss-narrow-start (point-min))
455 (setq syntax-ppss-narrow (cons nil nil)))
456 syntax-ppss-narrow))
457
426(defun syntax-ppss (&optional pos) 458(defun syntax-ppss (&optional pos)
427 "Parse-Partial-Sexp State at POS, defaulting to point. 459 "Parse-Partial-Sexp State at POS, defaulting to point.
428The returned value is the same as that of `parse-partial-sexp' 460The returned value is the same as that of `parse-partial-sexp'
@@ -439,10 +471,13 @@ running the hook."
439 (syntax-propertize pos) 471 (syntax-propertize pos)
440 ;; 472 ;;
441 (with-syntax-table (or syntax-ppss-table (syntax-table)) 473 (with-syntax-table (or syntax-ppss-table (syntax-table))
442 (let ((old-ppss (cdr syntax-ppss-last)) 474 (let* ((cell (syntax-ppss--data))
443 (old-pos (car syntax-ppss-last)) 475 (ppss-last (car cell))
444 (ppss nil) 476 (ppss-cache (cdr cell))
445 (pt-min (point-min))) 477 (old-ppss (cdr ppss-last))
478 (old-pos (car ppss-last))
479 (ppss nil)
480 (pt-min (point-min)))
446 (if (and old-pos (> old-pos pos)) (setq old-pos nil)) 481 (if (and old-pos (> old-pos pos)) (setq old-pos nil))
447 ;; Use the OLD-POS if usable and close. Don't update the `last' cache. 482 ;; Use the OLD-POS if usable and close. Don't update the `last' cache.
448 (condition-case nil 483 (condition-case nil
@@ -475,7 +510,7 @@ running the hook."
475 ;; The OLD-* data can't be used. Consult the cache. 510 ;; The OLD-* data can't be used. Consult the cache.
476 (t 511 (t
477 (let ((cache-pred nil) 512 (let ((cache-pred nil)
478 (cache syntax-ppss-cache) 513 (cache ppss-cache)
479 (pt-min (point-min)) 514 (pt-min (point-min))
480 ;; I differentiate between PT-MIN and PT-BEST because 515 ;; I differentiate between PT-MIN and PT-BEST because
481 ;; I feel like it might be important to ensure that the 516 ;; I feel like it might be important to ensure that the
@@ -491,7 +526,7 @@ running the hook."
491 (if cache (setq pt-min (caar cache) ppss (cdar cache))) 526 (if cache (setq pt-min (caar cache) ppss (cdar cache)))
492 527
493 ;; Setup the before-change function if necessary. 528 ;; Setup the before-change function if necessary.
494 (unless (or syntax-ppss-cache syntax-ppss-last) 529 (unless (or ppss-cache ppss-last)
495 (add-hook 'before-change-functions 530 (add-hook 'before-change-functions
496 'syntax-ppss-flush-cache t t)) 531 'syntax-ppss-flush-cache t t))
497 532
@@ -541,7 +576,7 @@ running the hook."
541 pt-min (setq pt-min (/ (+ pt-min pos) 2)) 576 pt-min (setq pt-min (/ (+ pt-min pos) 2))
542 nil nil ppss)) 577 nil nil ppss))
543 (push (cons pt-min ppss) 578 (push (cons pt-min ppss)
544 (if cache-pred (cdr cache-pred) syntax-ppss-cache))) 579 (if cache-pred (cdr cache-pred) ppss-cache)))
545 580
546 ;; Compute the actual return value. 581 ;; Compute the actual return value.
547 (setq ppss (parse-partial-sexp pt-min pos nil nil ppss)) 582 (setq ppss (parse-partial-sexp pt-min pos nil nil ppss))
@@ -562,13 +597,15 @@ running the hook."
562 (if (> (- (caar cache-pred) pos) syntax-ppss-max-span) 597 (if (> (- (caar cache-pred) pos) syntax-ppss-max-span)
563 (push pair (cdr cache-pred)) 598 (push pair (cdr cache-pred))
564 (setcar cache-pred pair)) 599 (setcar cache-pred pair))
565 (if (or (null syntax-ppss-cache) 600 (if (or (null ppss-cache)
566 (> (- (caar syntax-ppss-cache) pos) 601 (> (- (caar ppss-cache) pos)
567 syntax-ppss-max-span)) 602 syntax-ppss-max-span))
568 (push pair syntax-ppss-cache) 603 (push pair ppss-cache)
569 (setcar syntax-ppss-cache pair))))))))) 604 (setcar ppss-cache pair)))))))))
570 605
571 (setq syntax-ppss-last (cons pos ppss)) 606 (setq ppss-last (cons pos ppss))
607 (setcar cell ppss-last)
608 (setcdr cell ppss-cache)
572 ppss) 609 ppss)
573 (args-out-of-range 610 (args-out-of-range
574 ;; If the buffer is more narrowed than when we built the cache, 611 ;; If the buffer is more narrowed than when we built the cache,
@@ -582,7 +619,7 @@ running the hook."
582(defun syntax-ppss-debug () 619(defun syntax-ppss-debug ()
583 (let ((pt nil) 620 (let ((pt nil)
584 (min-diffs nil)) 621 (min-diffs nil))
585 (dolist (x (append syntax-ppss-cache (list (cons (point-min) nil)))) 622 (dolist (x (append (cdr (syntax-ppss--data)) (list (cons (point-min) nil))))
586 (when pt (push (- pt (car x)) min-diffs)) 623 (when pt (push (- pt (car x)) min-diffs))
587 (setq pt (car x))) 624 (setq pt (car x)))
588 min-diffs)) 625 min-diffs))
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index 44a315f9806..69c67419835 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -25,7 +25,7 @@
25;;; Code: 25;;; Code:
26 26
27;;;###autoload 27;;;###autoload
28(defun timer-list (&optional _ignore-auto _nonconfirm) 28(defun list-timers (&optional _ignore-auto _nonconfirm)
29 "List all timers in a buffer." 29 "List all timers in a buffer."
30 (interactive) 30 (interactive)
31 (pop-to-buffer-same-window (get-buffer-create "*timer-list*")) 31 (pop-to-buffer-same-window (get-buffer-create "*timer-list*"))
@@ -67,7 +67,7 @@
67 (goto-char (point-min))) 67 (goto-char (point-min)))
68;; This command can be destructive if they don't know what they are 68;; This command can be destructive if they don't know what they are
69;; doing. Kids, don't try this at home! 69;; doing. Kids, don't try this at home!
70;;;###autoload (put 'timer-list 'disabled "Beware: manually canceling timers can ruin your Emacs session.") 70;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers can ruin your Emacs session.")
71 71
72(defvar timer-list-mode-map 72(defvar timer-list-mode-map
73 (let ((map (make-sparse-keymap))) 73 (let ((map (make-sparse-keymap)))
@@ -84,7 +84,7 @@
84 (setq bidi-paragraph-direction 'left-to-right) 84 (setq bidi-paragraph-direction 'left-to-right)
85 (setq truncate-lines t) 85 (setq truncate-lines t)
86 (buffer-disable-undo) 86 (buffer-disable-undo)
87 (setq-local revert-buffer-function 'timer-list) 87 (setq-local revert-buffer-function #'list-timers)
88 (setq buffer-read-only t) 88 (setq buffer-read-only t)
89 (setq header-line-format 89 (setq header-line-format
90 (format "%4s %10s %8s %s" 90 (format "%4s %10s %8s %s"
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index c204ec869b5..8b24ec3c430 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -142,7 +142,7 @@ function `string-to-number'."
142(defmacro eshell-condition-case (tag form &rest handlers) 142(defmacro eshell-condition-case (tag form &rest handlers)
143 "If `eshell-handle-errors' is non-nil, this is `condition-case'. 143 "If `eshell-handle-errors' is non-nil, this is `condition-case'.
144Otherwise, evaluates FORM with no error handling." 144Otherwise, evaluates FORM with no error handling."
145 (declare (indent 2)) 145 (declare (indent 2) (debug (sexp form &rest form)))
146 (if eshell-handle-errors 146 (if eshell-handle-errors
147 `(condition-case-unless-debug ,tag 147 `(condition-case-unless-debug ,tag
148 ,form 148 ,form
diff --git a/lisp/files.el b/lisp/files.el
index c55c8097c16..211457ac7d7 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -150,8 +150,13 @@ Called with an absolute file name as argument, it returns t to enable backup.")
150(defcustom buffer-offer-save nil 150(defcustom buffer-offer-save nil
151 "Non-nil in a buffer means always offer to save buffer on exit. 151 "Non-nil in a buffer means always offer to save buffer on exit.
152Do so even if the buffer is not visiting a file. 152Do so even if the buffer is not visiting a file.
153Automatically local in all buffers." 153Automatically local in all buffers.
154 :type 'boolean 154
155Set to the symbol `always' to offer to save buffer whenever
156`save-some-buffers' is called."
157 :type '(choice (const :tag "Never" nil)
158 (const :tag "On Emacs exit" t)
159 (const :tag "Whenever save-some-buffers is called" always))
155 :group 'backup) 160 :group 'backup)
156(make-variable-buffer-local 'buffer-offer-save) 161(make-variable-buffer-local 'buffer-offer-save)
157(put 'buffer-offer-save 'permanent-local t) 162(put 'buffer-offer-save 'permanent-local t)
@@ -5190,12 +5195,9 @@ change the additional actions you can take on files."
5190 (not (buffer-base-buffer buffer)) 5195 (not (buffer-base-buffer buffer))
5191 (or 5196 (or
5192 (buffer-file-name buffer) 5197 (buffer-file-name buffer)
5193 (and pred 5198 (with-current-buffer buffer
5194 (progn 5199 (or (eq buffer-offer-save 'always)
5195 (set-buffer buffer) 5200 (and pred buffer-offer-save (> (buffer-size) 0)))))
5196 (and buffer-offer-save (> (buffer-size) 0))))
5197 (buffer-local-value
5198 'write-contents-functions buffer))
5199 (or (not (functionp pred)) 5201 (or (not (functionp pred))
5200 (with-current-buffer buffer (funcall pred))) 5202 (with-current-buffer buffer (funcall pred)))
5201 (if arg 5203 (if arg
@@ -5336,7 +5338,7 @@ instance of such commands."
5336 "Make directory DIR if it is not already a directory. Return nil." 5338 "Make directory DIR if it is not already a directory. Return nil."
5337 (condition-case err 5339 (condition-case err
5338 (make-directory-internal dir) 5340 (make-directory-internal dir)
5339 (file-already-exists 5341 (error
5340 (unless (file-directory-p dir) 5342 (unless (file-directory-p dir)
5341 (signal (car err) (cdr err)))))) 5343 (signal (car err) (cdr err))))))
5342 5344
@@ -5372,7 +5374,7 @@ raised."
5372 (while (progn 5374 (while (progn
5373 (setq parent (directory-file-name 5375 (setq parent (directory-file-name
5374 (file-name-directory dir))) 5376 (file-name-directory dir)))
5375 (condition-case err 5377 (condition-case ()
5376 (files--ensure-directory dir) 5378 (files--ensure-directory dir)
5377 (file-missing 5379 (file-missing
5378 ;; Do not loop if root does not exist (Bug#2309). 5380 ;; Do not loop if root does not exist (Bug#2309).
@@ -5544,16 +5546,14 @@ into NEWNAME instead."
5544 ;; If NEWNAME is not a directory name, create it; 5546 ;; If NEWNAME is not a directory name, create it;
5545 ;; that is where we will copy the files of DIRECTORY. 5547 ;; that is where we will copy the files of DIRECTORY.
5546 (make-directory newname parents)) 5548 (make-directory newname parents))
5547 ;; If NEWNAME is a directory name and COPY-CONTENTS 5549 ;; NEWNAME is a directory name. If COPY-CONTENTS is non-nil,
5548 ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME]. 5550 ;; create NEWNAME if it is not already a directory;
5549 ((not copy-contents) 5551 ;; otherwise, create NEWNAME/[DIRECTORY-BASENAME].
5550 (setq newname (concat newname 5552 ((if copy-contents
5551 (file-name-nondirectory directory))) 5553 (or parents (not (file-directory-p newname)))
5552 (and (file-exists-p newname) 5554 (setq newname (concat newname
5553 (not (file-directory-p newname)) 5555 (file-name-nondirectory directory))))
5554 (error "Cannot overwrite non-directory %s with a directory" 5556 (make-directory (directory-file-name newname) parents)))
5555 newname))
5556 (make-directory newname t)))
5557 5557
5558 ;; Copy recursively. 5558 ;; Copy recursively.
5559 (dolist (file 5559 (dolist (file
@@ -5565,7 +5565,7 @@ into NEWNAME instead."
5565 (filetype (car (file-attributes file)))) 5565 (filetype (car (file-attributes file))))
5566 (cond 5566 (cond
5567 ((eq filetype t) ; Directory but not a symlink. 5567 ((eq filetype t) ; Directory but not a symlink.
5568 (copy-directory file newname keep-time parents)) 5568 (copy-directory file target keep-time parents t))
5569 ((stringp filetype) ; Symbolic link 5569 ((stringp filetype) ; Symbolic link
5570 (make-symbolic-link filetype target t)) 5570 (make-symbolic-link filetype target t))
5571 ((copy-file file target t keep-time))))) 5571 ((copy-file file target t keep-time)))))
diff --git a/lisp/frame.el b/lisp/frame.el
index 5f0e97d5b07..76c1842455c 100644
--- a/lisp/frame.el
+++ b/lisp/frame.el
@@ -604,11 +604,12 @@ new frame."
604 (select-frame (make-frame)))) 604 (select-frame (make-frame))))
605 605
606(defvar before-make-frame-hook nil 606(defvar before-make-frame-hook nil
607 "Functions to run before a frame is created.") 607 "Functions to run before `make-frame' creates a new frame.")
608 608
609(defvar after-make-frame-functions nil 609(defvar after-make-frame-functions nil
610 "Functions to run after a frame is created. 610 "Functions to run after `make-frame' created a new frame.
611The functions are run with one arg, the newly created frame.") 611The functions are run with one argument, the newly created
612frame.")
612 613
613(defvar after-setting-font-hook nil 614(defvar after-setting-font-hook nil
614 "Functions to run after a frame's font has been changed.") 615 "Functions to run after a frame's font has been changed.")
@@ -617,7 +618,7 @@ The functions are run with one arg, the newly created frame.")
617(define-obsolete-function-alias 'new-frame 'make-frame "22.1") 618(define-obsolete-function-alias 'new-frame 'make-frame "22.1")
618 619
619(defvar frame-inherited-parameters '() 620(defvar frame-inherited-parameters '()
620 "Parameters `make-frame' copies from the `selected-frame' to the new frame.") 621 "Parameters `make-frame' copies from the selected to the new frame.")
621 622
622(defvar x-display-name) 623(defvar x-display-name)
623 624
@@ -632,9 +633,6 @@ form (NAME . VALUE), for example:
632 (width . NUMBER) The frame should be NUMBER characters in width. 633 (width . NUMBER) The frame should be NUMBER characters in width.
633 (height . NUMBER) The frame should be NUMBER text lines high. 634 (height . NUMBER) The frame should be NUMBER text lines high.
634 635
635You cannot specify either `width' or `height', you must specify
636neither or both.
637
638 (minibuffer . t) The frame should have a minibuffer. 636 (minibuffer . t) The frame should have a minibuffer.
639 (minibuffer . nil) The frame should have no minibuffer. 637 (minibuffer . nil) The frame should have no minibuffer.
640 (minibuffer . only) The frame should contain only a minibuffer. 638 (minibuffer . only) The frame should contain only a minibuffer.
@@ -650,10 +648,10 @@ neither or both.
650In addition, any parameter specified in `default-frame-alist', 648In addition, any parameter specified in `default-frame-alist',
651but not present in PARAMETERS, is applied. 649but not present in PARAMETERS, is applied.
652 650
653Before creating the frame (via `frame-creation-function-alist'), 651Before creating the frame (via `frame-creation-function'), this
654this function runs the hook `before-make-frame-hook'. After 652function runs the hook `before-make-frame-hook'. After creating
655creating the frame, it runs the hook `after-make-frame-functions' 653the frame, it runs the hook `after-make-frame-functions' with one
656with one arg, the newly created frame. 654argument, the newly created frame.
657 655
658If a display parameter is supplied and a window-system is not, 656If a display parameter is supplied and a window-system is not,
659guess the window-system from the display. 657guess the window-system from the display.
diff --git a/lisp/frameset.el b/lisp/frameset.el
index 661f0aee273..593451a4d75 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -447,7 +447,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
447 (buffer-predicate . :never) 447 (buffer-predicate . :never)
448 (buried-buffer-list . :never) 448 (buried-buffer-list . :never)
449 (delete-before . :never) 449 (delete-before . :never)
450 (font . frameset-filter-shelve-param) 450 (font . frameset-filter-font-param)
451 (foreground-color . frameset-filter-sanitize-color) 451 (foreground-color . frameset-filter-sanitize-color)
452 (fullscreen . frameset-filter-shelve-param) 452 (fullscreen . frameset-filter-shelve-param)
453 (GUI:font . frameset-filter-unshelve-param) 453 (GUI:font . frameset-filter-unshelve-param)
@@ -631,6 +631,17 @@ see `frameset-filter-alist'."
631 (setcdr found val) 631 (setcdr found val)
632 nil)))) 632 nil))))
633 633
634(defun frameset-filter-font-param (current filtered parameters saving
635 &optional prefix)
636 "When switching from a tty frame to a GUI frame, remove the FONT param.
637
638When switching from a GUI frame to a tty frame, behave
639as `frameset-filter-shelve-param' does."
640 (or saving
641 (if (frameset-switch-to-gui-p parameters)
642 (frameset-filter-shelve-param current filtered parameters saving
643 prefix))))
644
634(defun frameset-filter-iconified (_current _filtered parameters saving) 645(defun frameset-filter-iconified (_current _filtered parameters saving)
635 "Remove CURRENT when saving an iconified frame. 646 "Remove CURRENT when saving an iconified frame.
636This is used for positional parameters `left' and `top', which are 647This is used for positional parameters `left' and `top', which are
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index 690dd28c8a4..a9e66cede16 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -991,7 +991,6 @@ are replaced:
991 %F The first name if present, e.g.: \"John\", else fall 991 %F The first name if present, e.g.: \"John\", else fall
992 back to the mail address. 992 back to the mail address.
993 %L The last name if present, e.g.: \"Doe\". 993 %L The last name if present, e.g.: \"Doe\".
994 %Z, %z The time zone in the numeric form, e.g.:\"+0000\".
995 994
996All other format specifiers are passed to `format-time-string' 995All other format specifiers are passed to `format-time-string'
997which is called using the date from the article your replying to, but 996which is called using the date from the article your replying to, but
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 3f448f018a4..169d2632f4f 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -1916,6 +1916,34 @@ CLICK position, kill the secondary selection."
1916 (> (length str) 0) 1916 (> (length str) 0)
1917 (gui-set-selection 'SECONDARY str)))) 1917 (gui-set-selection 'SECONDARY str))))
1918 1918
1919(defun secondary-selection-exist-p ()
1920 "Return non-nil if the secondary selection exists in the current buffer."
1921 (memq mouse-secondary-overlay (overlays-in (point-min) (point-max))))
1922
1923(defun secondary-selection-to-region ()
1924 "Set beginning and end of the region to those of the secondary selection.
1925This puts mark and point at the beginning and the end of the
1926secondary selection, respectively. This works when the secondary
1927selection exists and the region does not exist in current buffer;
1928the secondary selection will be deleted afterward.
1929If the region is active, or the secondary selection doesn't exist,
1930this function does nothing."
1931 (when (and (not (region-active-p))
1932 (secondary-selection-exist-p))
1933 (let ((beg (overlay-start mouse-secondary-overlay))
1934 (end (overlay-end mouse-secondary-overlay)))
1935 (push-mark beg t t)
1936 (goto-char end))
1937 ;; Delete the secondary selection on current buffer.
1938 (delete-overlay mouse-secondary-overlay)))
1939
1940(defun secondary-selection-from-region ()
1941 "Set beginning and end of the secondary selection to those of the region.
1942When there is no region, this function does nothing."
1943 (when (region-active-p) ; Create the secondary selection from the region.
1944 (delete-overlay mouse-secondary-overlay) ; Delete the secondary selection even on a different buffer.
1945 (move-overlay mouse-secondary-overlay (region-beginning) (region-end))))
1946
1919 1947
1920(defcustom mouse-buffer-menu-maxlen 20 1948(defcustom mouse-buffer-menu-maxlen 20
1921 "Number of buffers in one pane (submenu) of the buffer menu. 1949 "Number of buffers in one pane (submenu) of the buffer menu.
diff --git a/lisp/mwheel.el b/lisp/mwheel.el
index 2956ba55162..0c0dcb3beb1 100644
--- a/lisp/mwheel.el
+++ b/lisp/mwheel.el
@@ -232,6 +232,7 @@ non-Windows systems."
232 ;; When the double-mouse-N comes in, a mouse-N has been executed already, 232 ;; When the double-mouse-N comes in, a mouse-N has been executed already,
233 ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...). 233 ;; So by adding things up we get a squaring up (1, 3, 6, 10, 15, ...).
234 (setq amt (* amt (event-click-count event)))) 234 (setq amt (* amt (event-click-count event))))
235 (when (numberp amt) (setq amt (* amt (event-line-count event))))
235 (unwind-protect 236 (unwind-protect
236 (let ((button (mwheel-event-button event))) 237 (let ((button (mwheel-event-button event)))
237 (cond ((eq button mouse-wheel-down-event) 238 (cond ((eq button mouse-wheel-down-event)
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index ed35c220ec5..86587466ef5 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -165,9 +165,13 @@ is consulted."
165 (type . "application/zip") 165 (type . "application/zip")
166 ("copiousoutput")) 166 ("copiousoutput"))
167 ("pdf" 167 ("pdf"
168 (viewer . pdf-view-mode)
169 (type . "application/pdf")
170 (test . window-system))
171 ("pdf"
168 (viewer . doc-view-mode) 172 (viewer . doc-view-mode)
169 (type . "application/pdf") 173 (type . "application/pdf")
170 (test . (eq window-system 'x))) 174 (test . window-system))
171 ("pdf" 175 ("pdf"
172 (viewer . "gv -safer %s") 176 (viewer . "gv -safer %s")
173 (type . "application/pdf") 177 (type . "application/pdf")
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index c22869d2cc2..760d020f672 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -740,7 +740,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
740 740
741 ;; Remote newname. 741 ;; Remote newname.
742 (when (and (file-directory-p newname) 742 (when (and (file-directory-p newname)
743 (directory-name-p newname)) 743 (tramp-compat-directory-name-p newname))
744 (setq newname 744 (setq newname
745 (expand-file-name 745 (expand-file-name
746 (file-name-nondirectory filename) newname))) 746 (file-name-nondirectory filename) newname)))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 5d9a1fd1967..214ad040a17 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -23,8 +23,9 @@
23 23
24;;; Commentary: 24;;; Commentary:
25 25
26;; Tramp's main Emacs version for development is Emacs 26. This 26;; Tramp's main Emacs version for development is Emacs 27. This
27;; package provides compatibility functions for Emacs 24 and Emacs 25. 27;; package provides compatibility functions for Emacs 24, Emacs 25 and
28;; Emacs 26.
28 29
29;;; Code: 30;;; Code:
30 31
@@ -104,6 +105,10 @@ Add the extension of F, if existing."
104 'tramp-error vec-or-proc 105 'tramp-error vec-or-proc
105 (if (fboundp 'user-error) 'user-error 'error) format args)) 106 (if (fboundp 'user-error) 'user-error 'error) format args))
106 107
108;; `default-toplevel-value' has been declared in Emacs 24.4.
109(unless (fboundp 'default-toplevel-value)
110 (defalias 'default-toplevel-value 'symbol-value))
111
107;; `file-attribute-*' are introduced in Emacs 25.1. 112;; `file-attribute-*' are introduced in Emacs 25.1.
108 113
109(if (fboundp 'file-attribute-type) 114(if (fboundp 'file-attribute-type)
@@ -163,14 +168,23 @@ This is a floating point number if the size is too large for an integer."
163This is a string of ten letters or dashes as in ls -l." 168This is a string of ten letters or dashes as in ls -l."
164 (nth 8 attributes))) 169 (nth 8 attributes)))
165 170
166;; `default-toplevel-value' has been declared in Emacs 24.4.
167(unless (fboundp 'default-toplevel-value)
168 (defalias 'default-toplevel-value 'symbol-value))
169
170;; `format-message' is new in Emacs 25.1. 171;; `format-message' is new in Emacs 25.1.
171(unless (fboundp 'format-message) 172(unless (fboundp 'format-message)
172 (defalias 'format-message 'format)) 173 (defalias 'format-message 'format))
173 174
175;; `directory-name-p' is new in Emacs 25.1.
176(if (fboundp 'directory-name-p)
177 (defalias 'tramp-compat-directory-name-p 'directory-name-p)
178 (defsubst tramp-compat-directory-name-p (name)
179 "Return non-nil if NAME ends with a directory separator character."
180 (let ((len (length name))
181 (lastc ?.))
182 (if (> len 0)
183 (setq lastc (aref name (1- len))))
184 (or (= lastc ?/)
185 (and (memq system-type '(windows-nt ms-dos))
186 (= lastc ?\\))))))
187
174;; `file-missing' is introduced in Emacs 26.1. 188;; `file-missing' is introduced in Emacs 26.1.
175(defconst tramp-file-missing 189(defconst tramp-file-missing
176 (if (get 'file-missing 'error-conditions) 'file-missing 'file-error) 190 (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
@@ -221,13 +235,6 @@ If NAME is a remote file name, the local part of NAME is unquoted."
221 ((eq tramp-syntax 'sep) 'separate) 235 ((eq tramp-syntax 'sep) 'separate)
222 (t tramp-syntax))) 236 (t tramp-syntax)))
223 237
224;; Older Emacsen keep incompatible autoloaded values of `tramp-syntax'.
225(eval-after-load 'tramp
226 '(unless
227 (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values)))
228 (tramp-compat-funcall
229 (quote tramp-change-syntax) (tramp-compat-tramp-syntax))))
230
231(provide 'tramp-compat) 238(provide 'tramp-compat)
232 239
233;;; TODO: 240;;; TODO:
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 7df5aa3b7b0..a744a53ca42 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -613,7 +613,7 @@ use Cwd \"realpath\";
613 613
614sub myrealpath { 614sub myrealpath {
615 my ($file) = @_; 615 my ($file) = @_;
616 return realpath($file) if -e $file; 616 return realpath($file) if (-e $file || -l $file);
617} 617}
618 618
619sub recursive { 619sub recursive {
@@ -1139,12 +1139,7 @@ component is used as the target of the symlink."
1139 (tramp-shell-quote-argument localname))) 1139 (tramp-shell-quote-argument localname)))
1140 (with-current-buffer (tramp-get-connection-buffer v) 1140 (with-current-buffer (tramp-get-connection-buffer v)
1141 (goto-char (point-min)) 1141 (goto-char (point-min))
1142 (setq result (buffer-substring (point-min) (point-at-eol)))) 1142 (setq result (buffer-substring (point-min) (point-at-eol)))))
1143 (when (and (file-symlink-p filename)
1144 (string-equal result localname))
1145 (tramp-error
1146 v 'file-error
1147 "Apparent cycle of symbolic links for %s" filename)))
1148 1143
1149 ;; Use Perl implementation. 1144 ;; Use Perl implementation.
1150 ((and (tramp-get-remote-perl v) 1145 ((and (tramp-get-remote-perl v)
@@ -1198,16 +1193,6 @@ component is used as the target of the symlink."
1198 (setq numchase (1+ numchase)) 1193 (setq numchase (1+ numchase))
1199 (when (file-name-absolute-p symlink-target) 1194 (when (file-name-absolute-p symlink-target)
1200 (setq result nil)) 1195 (setq result nil))
1201 ;; If the symlink was absolute, we'll get a
1202 ;; string like "/user@host:/some/target";
1203 ;; extract the "/some/target" part from it.
1204 (when (tramp-tramp-file-p symlink-target)
1205 (unless (tramp-equal-remote filename symlink-target)
1206 (tramp-error
1207 v 'file-error
1208 "Symlink target `%s' on wrong host"
1209 symlink-target))
1210 (setq symlink-target localname))
1211 (setq steps 1196 (setq steps
1212 (append 1197 (append
1213 (split-string symlink-target "/" 'omit) steps))) 1198 (split-string symlink-target "/" 'omit) steps)))
@@ -1226,6 +1211,13 @@ component is used as the target of the symlink."
1226 "/")) 1211 "/"))
1227 (when (string= "" result) 1212 (when (string= "" result)
1228 (setq result "/"))))) 1213 (setq result "/")))))
1214
1215 ;; Detect cycle.
1216 (when (and (file-symlink-p filename)
1217 (string-equal result localname))
1218 (tramp-error
1219 v 'file-error
1220 "Apparent cycle of symbolic links for %s" filename))
1229 ;; If the resulting localname looks remote, we must quote it 1221 ;; If the resulting localname looks remote, we must quote it
1230 ;; for security reasons. 1222 ;; for security reasons.
1231 (when (or quoted (file-remote-p result)) 1223 (when (or quoted (file-remote-p result))
@@ -1985,7 +1977,7 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
1985 ;; scp or rsync DTRT. 1977 ;; scp or rsync DTRT.
1986 (progn 1978 (progn
1987 (when (and (file-directory-p newname) 1979 (when (and (file-directory-p newname)
1988 (not (directory-name-p newname))) 1980 (not (tramp-compat-directory-name-p newname)))
1989 (tramp-error v 'file-already-exists newname)) 1981 (tramp-error v 'file-already-exists newname))
1990 (setq dirname (directory-file-name (expand-file-name dirname)) 1982 (setq dirname (directory-file-name (expand-file-name dirname))
1991 newname (directory-file-name (expand-file-name newname))) 1983 newname (directory-file-name (expand-file-name newname)))
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 49695666707..35aa8110946 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -415,7 +415,7 @@ pass to the OPERATION."
415 (with-tramp-progress-reporter 415 (with-tramp-progress-reporter
416 v 0 (format "Copying %s to %s" dirname newname) 416 v 0 (format "Copying %s to %s" dirname newname)
417 (when (and (file-directory-p newname) 417 (when (and (file-directory-p newname)
418 (not (directory-name-p newname))) 418 (not (tramp-compat-directory-name-p newname)))
419 (tramp-error v 'file-already-exists newname)) 419 (tramp-error v 'file-already-exists newname))
420 (cond 420 (cond
421 ;; We must use a local temporary directory. 421 ;; We must use a local temporary directory.
@@ -535,7 +535,7 @@ pass to the OPERATION."
535 ;; Reset the transfer process properties. 535 ;; Reset the transfer process properties.
536 (tramp-set-connection-property v "process-name" nil) 536 (tramp-set-connection-property v "process-name" nil)
537 (tramp-set-connection-property v "process-buffer" nil) 537 (tramp-set-connection-property v "process-buffer" nil)
538 (when t1 (delete-directory tmpdir 'recurse)))) 538 (when t1 (delete-directory tmpdir 'recursive))))
539 539
540 ;; Handle KEEP-DATE argument. 540 ;; Handle KEEP-DATE argument.
541 (when keep-date 541 (when keep-date
@@ -586,7 +586,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
586 586
587 ;; Remote newname. 587 ;; Remote newname.
588 (when (and (file-directory-p newname) 588 (when (and (file-directory-p newname)
589 (directory-name-p newname)) 589 (tramp-compat-directory-name-p newname))
590 (setq newname 590 (setq newname
591 (expand-file-name (file-name-nondirectory filename) newname))) 591 (expand-file-name (file-name-nondirectory filename) newname)))
592 592
@@ -1583,6 +1583,10 @@ If VEC has no cifs capabilities, exchange \"/\" by \"\\\\\"."
1583 "Read entries which match DIRECTORY. 1583 "Read entries which match DIRECTORY.
1584Either the shares are listed, or the `dir' command is executed. 1584Either the shares are listed, or the `dir' command is executed.
1585Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." 1585Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)."
1586 ;; If CIFS capabilities are enabled, symlinks are not listed
1587 ;; by `dir'. This is a consequence of
1588 ;; <https://www.samba.org/samba/news/symlink_attack.html>. See also
1589 ;; <https://bugzilla.samba.org/show_bug.cgi?id=5116>.
1586 (with-parsed-tramp-file-name (file-name-as-directory directory) nil 1590 (with-parsed-tramp-file-name (file-name-as-directory directory) nil
1587 (setq localname (or localname "/")) 1591 (setq localname (or localname "/"))
1588 (with-tramp-file-property v localname "file-entries" 1592 (with-tramp-file-property v localname "file-entries"
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 45776078be3..3573eeb7d49 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3169,7 +3169,7 @@ User is always nil."
3169 3169
3170(defun tramp-handle-file-truename (filename) 3170(defun tramp-handle-file-truename (filename)
3171 "Like `file-truename' for Tramp files." 3171 "Like `file-truename' for Tramp files."
3172 (let ((result filename) 3172 (let ((result (expand-file-name filename))
3173 (numchase 0) 3173 (numchase 0)
3174 ;; Don't make the following value larger than 3174 ;; Don't make the following value larger than
3175 ;; necessary. People expect an error message in a 3175 ;; necessary. People expect an error message in a
@@ -3180,7 +3180,7 @@ User is always nil."
3180 symlink-target) 3180 symlink-target)
3181 (format 3181 (format
3182 "%s%s" 3182 "%s%s"
3183 (with-parsed-tramp-file-name (expand-file-name result) v1 3183 (with-parsed-tramp-file-name result v1
3184 (with-tramp-file-property v1 v1-localname "file-truename" 3184 (with-tramp-file-property v1 v1-localname "file-truename"
3185 (while (and (setq symlink-target (file-symlink-p result)) 3185 (while (and (setq symlink-target (file-symlink-p result))
3186 (< numchase numchase-limit)) 3186 (< numchase numchase-limit))
@@ -3850,7 +3850,7 @@ Erase echoed commands if exists."
3850 (min (+ (point-min) tramp-echo-mark-marker-length) 3850 (min (+ (point-min) tramp-echo-mark-marker-length)
3851 (point-max)))))) 3851 (point-max))))))
3852 ;; No echo to be handled, now we can look for the regexp. 3852 ;; No echo to be handled, now we can look for the regexp.
3853 ;; Sometimes, lines are much to long, and we run into a "Stack 3853 ;; Sometimes, lines are much too long, and we run into a "Stack
3854 ;; overflow in regexp matcher". For example, //DIRED// lines of 3854 ;; overflow in regexp matcher". For example, //DIRED// lines of
3855 ;; directory listings with some thousand files. Therefore, we 3855 ;; directory listings with some thousand files. Therefore, we
3856 ;; look from the end. 3856 ;; look from the end.
@@ -4547,16 +4547,23 @@ Only works for Bourne-like shells."
4547 (t process))) 4547 (t process)))
4548 pid) 4548 pid)
4549 ;; If it's a Tramp process, send the INT signal remotely. 4549 ;; If it's a Tramp process, send the INT signal remotely.
4550 (when (and (processp proc) (process-live-p proc) 4550 (when (and (processp proc) (setq pid (process-get proc 'remote-pid)))
4551 (setq pid (process-get proc 'remote-pid))) 4551 (if (not (process-live-p proc))
4552 (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid) 4552 (tramp-error proc 'error "Process %s is not active" proc)
4553 ;; This is for tramp-sh.el. Other backends do not support this (yet). 4553 (tramp-message proc 5 "Interrupt process %s with pid %s" proc pid)
4554 (tramp-compat-funcall 4554 ;; This is for tramp-sh.el. Other backends do not support this (yet).
4555 'tramp-send-command 4555 (tramp-compat-funcall
4556 (tramp-get-connection-property proc "vector" nil) 4556 'tramp-send-command
4557 (format "kill -2 %d" pid)) 4557 (tramp-get-connection-property proc "vector" nil)
4558 ;; Report success. 4558 (format "kill -2 %d" pid))
4559 proc))) 4559 ;; Wait, until the process has disappeared.
4560 (with-timeout
4561 (1 (tramp-error proc 'error "Process %s did not interrupt" proc))
4562 (while (process-live-p proc)
4563 ;; We cannot run `tramp-accept-process-output', it blocks timers.
4564 (accept-process-output proc 0.1)))
4565 ;; Report success.
4566 proc))))
4560 4567
4561;; `interrupt-process-functions' exists since Emacs 26.1. 4568;; `interrupt-process-functions' exists since Emacs 26.1.
4562(when (boundp 'interrupt-process-functions) 4569(when (boundp 'interrupt-process-functions)
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 91222bd7817..318e3351237 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -7,7 +7,7 @@
7;; Maintainer: Michael Albinus <michael.albinus@gmx.de> 7;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
8;; Keywords: comm, processes 8;; Keywords: comm, processes
9;; Package: tramp 9;; Package: tramp
10;; Version: 2.3.3-pre 10;; Version: 2.3.3.26.1
11 11
12;; This file is part of GNU Emacs. 12;; This file is part of GNU Emacs.
13 13
@@ -33,7 +33,7 @@
33;; should be changed only there. 33;; should be changed only there.
34 34
35;;;###tramp-autoload 35;;;###tramp-autoload
36(defconst tramp-version "2.3.3-pre" 36(defconst tramp-version "2.3.3.26.1"
37 "This version of Tramp.") 37 "This version of Tramp.")
38 38
39;;;###tramp-autoload 39;;;###tramp-autoload
@@ -55,7 +55,7 @@
55;; Check for Emacs version. 55;; Check for Emacs version.
56(let ((x (if (>= emacs-major-version 24) 56(let ((x (if (>= emacs-major-version 24)
57 "ok" 57 "ok"
58 (format "Tramp 2.3.3-pre is not fit for %s" 58 (format "Tramp 2.3.3.26.1 is not fit for %s"
59 (when (string-match "^.*$" (emacs-version)) 59 (when (string-match "^.*$" (emacs-version))
60 (match-string 0 (emacs-version))))))) 60 (match-string 0 (emacs-version)))))))
61 (unless (string-match "\\`ok\\'" x) (error "%s" x))) 61 (unless (string-match "\\`ok\\'" x) (error "%s" x)))
@@ -69,7 +69,8 @@
69 ("2.2.3-24.1" . "24.1") ("2.2.3-24.1" . "24.2") ("2.2.6-24.3" . "24.3") 69 ("2.2.3-24.1" . "24.1") ("2.2.3-24.1" . "24.2") ("2.2.6-24.3" . "24.3")
70 ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5") 70 ("2.2.9-24.4" . "24.4") ("2.2.11-24.5" . "24.5")
71 ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2") 71 ("2.2.13.25.1" . "25.1") ("2.2.13.25.2" . "25.2")
72 ("2.2.13.25.2" . "25.3"))) 72 ("2.2.13.25.2" . "25.3")
73 ("2.3.3.26.1" . "26.1")))
73 74
74(add-hook 'tramp-unload-hook 75(add-hook 'tramp-unload-hook
75 (lambda () 76 (lambda ()
diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1
index 366a3ee9fcd..ee50f6fb040 100644
--- a/lisp/org/ChangeLog.1
+++ b/lisp/org/ChangeLog.1
@@ -5015,10 +5015,10 @@
5015 * ox-latex.el (org-latex-listings): Update docstring. 5015 * ox-latex.el (org-latex-listings): Update docstring.
5016 5016
5017 * org-pcomplete.el (pcomplete/org-mode/file-option/options): 5017 * org-pcomplete.el (pcomplete/org-mode/file-option/options):
5018 Apply changes to export back-end definiton. 5018 Apply changes to export back-end definition.
5019 5019
5020 * org.el (org-get-export-keywords): Apply changes to export 5020 * org.el (org-get-export-keywords): Apply changes to export
5021 back-end definiton. 5021 back-end definition.
5022 5022
5023 * ox-html.el (org-html--format-toc-headline): Make use of 5023 * ox-html.el (org-html--format-toc-headline): Make use of
5024 anonymous back-ends. 5024 anonymous back-ends.
diff --git a/lisp/progmodes/bat-mode.el b/lisp/progmodes/bat-mode.el
index f4852fe5b6b..102c3186200 100644
--- a/lisp/progmodes/bat-mode.el
+++ b/lisp/progmodes/bat-mode.el
@@ -84,11 +84,11 @@
84 . 'bat-label-face) 84 . 'bat-label-face)
85 ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)" 85 ("\\_<\\(defined\\|set\\)\\_>[ \t]*\\(\\(\\sw\\|\\s_\\)+\\)"
86 (2 font-lock-variable-name-face)) 86 (2 font-lock-variable-name-face))
87 ("%\\(\\(\\sw\\|\\s_\\)+\\)%" 87 ("%\\([^%~ \n]+\\)%?"
88 (1 font-lock-variable-name-face)) 88 (1 font-lock-variable-name-face))
89 ("!\\(\\(\\sw\\|\\s_\\)+\\)!" ; delayed-expansion !variable! 89 ("!\\([^!%~ \n]+\\)!?" ; delayed-expansion !variable!
90 (1 font-lock-variable-name-face)) 90 (1 font-lock-variable-name-face))
91 ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)" 91 ("%%\\(?:~[adfnpstxz]*\\(?:\\$\\(\\(?:\\sw\\|\\s_\\|_\\)+\\):\\)?\\)?\\([]!#$&-:?-[_-{}~]\\)"
92 (1 font-lock-variable-name-face nil t) ; PATH expansion 92 (1 font-lock-variable-name-face nil t) ; PATH expansion
93 (2 font-lock-variable-name-face)) ; iteration variable or positional parameter 93 (2 font-lock-variable-name-face)) ; iteration variable or positional parameter
94 ("[ =][-/]+\\(\\w+\\)" 94 ("[ =][-/]+\\(\\w+\\)"
diff --git a/lisp/progmodes/flymake-proc.el b/lisp/progmodes/flymake-proc.el
deleted file mode 100644
index df1a0750cfb..00000000000
--- a/lisp/progmodes/flymake-proc.el
+++ /dev/null
@@ -1,1100 +0,0 @@
1;;; flymake-proc.el --- Flymake for external syntax checker processes -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
4
5;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
6;; Maintainer: Leo Liu <sdl.web@gmail.com>
7;; Version: 0.3
8;; Keywords: c languages tools
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
24
25;;; Commentary:
26;;
27;; Flymake is a minor Emacs mode performing on-the-fly syntax checks.
28;;
29;; This file contains the most original implementation of flymake's
30;; main source of on-the-fly diagnostic info, the external syntax
31;; checker backend.
32;;
33;;; Bugs/todo:
34
35;; - Only uses "Makefile", not "makefile" or "GNUmakefile"
36;; (from http://bugs.debian.org/337339).
37
38;;; Code:
39
40(require 'flymake-ui)
41
42(defcustom flymake-compilation-prevents-syntax-check t
43 "If non-nil, don't start syntax check if compilation is running."
44 :group 'flymake
45 :type 'boolean)
46
47(defcustom flymake-xml-program
48 (if (executable-find "xmlstarlet") "xmlstarlet" "xml")
49 "Program to use for XML validation."
50 :type 'file
51 :group 'flymake
52 :version "24.4")
53
54(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest")
55 "Dirs where to look for master files."
56 :group 'flymake
57 :type '(repeat (string)))
58
59(defcustom flymake-master-file-count-limit 32
60 "Max number of master files to check."
61 :group 'flymake
62 :type 'integer)
63
64(defcustom flymake-allowed-file-name-masks
65 '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init)
66 ("\\.xml\\'" flymake-xml-init)
67 ("\\.html?\\'" flymake-xml-init)
68 ("\\.cs\\'" flymake-simple-make-init)
69 ("\\.p[ml]\\'" flymake-perl-init)
70 ("\\.php[345]?\\'" flymake-php-init)
71 ("\\.h\\'" flymake-master-make-header-init flymake-master-cleanup)
72 ("\\.java\\'" flymake-simple-make-java-init flymake-simple-java-cleanup)
73 ("[0-9]+\\.tex\\'" flymake-master-tex-init flymake-master-cleanup)
74 ("\\.tex\\'" flymake-simple-tex-init)
75 ("\\.idl\\'" flymake-simple-make-init)
76 ;; ("\\.cpp\\'" 1)
77 ;; ("\\.java\\'" 3)
78 ;; ("\\.h\\'" 2 ("\\.cpp\\'" "\\.c\\'")
79 ;; ("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2))
80 ;; ("\\.idl\\'" 1)
81 ;; ("\\.odl\\'" 1)
82 ;; ("[0-9]+\\.tex\\'" 2 ("\\.tex\\'")
83 ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 ))
84 ;; ("\\.tex\\'" 1)
85 )
86 "Files syntax checking is allowed for.
87This is an alist with elements of the form:
88 REGEXP [INIT [CLEANUP [NAME]]]
89REGEXP is a regular expression that matches a file name.
90INIT is the init function to use, missing means disable `flymake-mode'.
91CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'.
92NAME is the file name function to use, default `flymake-get-real-file-name'."
93 :group 'flymake
94 :type '(alist :key-type (regexp :tag "File regexp")
95 :value-type
96 (list :tag "Handler functions"
97 (choice :tag "Init function"
98 (const :tag "disable" nil)
99 function)
100 (choice :tag "Cleanup function"
101 (const :tag "flymake-simple-cleanup" nil)
102 function)
103 (choice :tag "Name function"
104 (const :tag "flymake-get-real-file-name" nil)
105 function))))
106
107(defvar flymake-processes nil
108 "List of currently active flymake processes.")
109
110(defvar-local flymake-output-residual nil)
111
112(defun flymake-get-file-name-mode-and-masks (file-name)
113 "Return the corresponding entry from `flymake-allowed-file-name-masks'."
114 (unless (stringp file-name)
115 (error "Invalid file-name"))
116 (let ((fnm flymake-allowed-file-name-masks)
117 (mode-and-masks nil))
118 (while (and (not mode-and-masks) fnm)
119 (let ((item (pop fnm)))
120 (when (string-match (car item) file-name)
121 (setq mode-and-masks item)))) ; (cdr item) may be nil
122 (setq mode-and-masks (cdr mode-and-masks))
123 (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks))
124 mode-and-masks))
125
126(defun flymake-proc-can-syntax-check-buffer ()
127 "Determine whether we can syntax check current buffer.
128Return nil if we cannot, non-nil if
129we can."
130 (and buffer-file-name
131 (if (flymake-get-init-function buffer-file-name) t nil)))
132
133(defun flymake-get-init-function (file-name)
134 "Return init function to be used for the file."
135 (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name))))
136 ;;(flymake-log 0 "calling %s" init-f)
137 ;;(funcall init-f (current-buffer))
138 init-f))
139
140(defun flymake-get-cleanup-function (file-name)
141 "Return cleanup function to be used for the file."
142 (or (nth 1 (flymake-get-file-name-mode-and-masks file-name))
143 'flymake-simple-cleanup))
144
145(defun flymake-get-real-file-name-function (file-name)
146 (or (nth 2 (flymake-get-file-name-mode-and-masks file-name))
147 'flymake-get-real-file-name))
148
149(defvar flymake-find-buildfile-cache (make-hash-table :test #'equal))
150
151(defun flymake-get-buildfile-from-cache (dir-name)
152 "Look up DIR-NAME in cache and return its associated value.
153If DIR-NAME is not found, return nil."
154 (gethash dir-name flymake-find-buildfile-cache))
155
156(defun flymake-add-buildfile-to-cache (dir-name buildfile)
157 "Associate DIR-NAME with BUILDFILE in the buildfile cache."
158 (puthash dir-name buildfile flymake-find-buildfile-cache))
159
160(defun flymake-clear-buildfile-cache ()
161 "Clear the buildfile cache."
162 (clrhash flymake-find-buildfile-cache))
163
164(defun flymake-find-buildfile (buildfile-name source-dir-name)
165 "Find buildfile starting from current directory.
166Buildfile includes Makefile, build.xml etc.
167Return its file name if found, or nil if not found."
168 (or (flymake-get-buildfile-from-cache source-dir-name)
169 (let* ((file (locate-dominating-file source-dir-name buildfile-name)))
170 (if file
171 (progn
172 (flymake-log 3 "found buildfile at %s" file)
173 (flymake-add-buildfile-to-cache source-dir-name file)
174 file)
175 (progn
176 (flymake-log 3 "buildfile for %s not found" source-dir-name)
177 nil)))))
178
179(defun flymake-fix-file-name (name)
180 "Replace all occurrences of `\\' with `/'."
181 (when name
182 (setq name (expand-file-name name))
183 (setq name (abbreviate-file-name name))
184 (setq name (directory-file-name name))
185 name))
186
187(defun flymake-same-files (file-name-one file-name-two)
188 "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file.
189Return t if so, nil if not."
190 (equal (flymake-fix-file-name file-name-one)
191 (flymake-fix-file-name file-name-two)))
192
193;; This is bound dynamically to pass a parameter to a sort predicate below
194(defvar flymake-included-file-name)
195
196(defun flymake-find-possible-master-files (file-name master-file-dirs masks)
197 "Find (by name and location) all possible master files.
198
199Name is specified by FILE-NAME and location is specified by
200MASTER-FILE-DIRS. Master files include .cpp and .c for .h.
201Files are searched for starting from the .h directory and max
202max-level parent dirs. File contents are not checked."
203 (let* ((dirs master-file-dirs)
204 (files nil)
205 (done nil))
206
207 (while (and (not done) dirs)
208 (let* ((dir (expand-file-name (car dirs) (file-name-directory file-name)))
209 (masks masks))
210 (while (and (file-exists-p dir) (not done) masks)
211 (let* ((mask (car masks))
212 (dir-files (directory-files dir t mask)))
213
214 (flymake-log 3 "dir %s, %d file(s) for mask %s"
215 dir (length dir-files) mask)
216 (while (and (not done) dir-files)
217 (when (not (file-directory-p (car dir-files)))
218 (setq files (cons (car dir-files) files))
219 (when (>= (length files) flymake-master-file-count-limit)
220 (flymake-log 3 "master file count limit (%d) reached" flymake-master-file-count-limit)
221 (setq done t)))
222 (setq dir-files (cdr dir-files))))
223 (setq masks (cdr masks))))
224 (setq dirs (cdr dirs)))
225 (when files
226 (let ((flymake-included-file-name (file-name-nondirectory file-name)))
227 (setq files (sort files 'flymake-master-file-compare))))
228 (flymake-log 3 "found %d possible master file(s)" (length files))
229 files))
230
231(defun flymake-master-file-compare (file-one file-two)
232 "Compare two files specified by FILE-ONE and FILE-TWO.
233This function is used in sort to move most possible file names
234to the beginning of the list (File.h -> File.cpp moved to top)."
235 (and (equal (file-name-sans-extension flymake-included-file-name)
236 (file-name-base file-one))
237 (not (equal file-one file-two))))
238
239(defvar flymake-check-file-limit 8192
240 "Maximum number of chars to look at when checking possible master file.
241Nil means search the entire file.")
242
243(defun flymake-check-patch-master-file-buffer
244 (master-file-temp-buffer
245 master-file-name patched-master-file-name
246 source-file-name patched-source-file-name
247 include-dirs regexp)
248 "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME.
249If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME
250instead of SOURCE-FILE-NAME.
251
252For example, foo.cpp is a master file if it includes foo.h.
253
254When a buffer for MASTER-FILE-NAME exists, use it as a source
255instead of reading master file from disk."
256 (let* ((source-file-nondir (file-name-nondirectory source-file-name))
257 (source-file-extension (file-name-extension source-file-nondir))
258 (source-file-nonext (file-name-sans-extension source-file-nondir))
259 (found nil)
260 (inc-name nil)
261 (search-limit flymake-check-file-limit))
262 (setq regexp
263 (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\""
264 ;; Hack for tex files, where \include often excludes .tex.
265 ;; Maybe this is safe generally.
266 (if (and (> (length source-file-extension) 1)
267 (string-equal source-file-extension "tex"))
268 (format "%s\\(?:\\.%s\\)?"
269 (regexp-quote source-file-nonext)
270 (regexp-quote source-file-extension))
271 (regexp-quote source-file-nondir))))
272 (unwind-protect
273 (with-current-buffer master-file-temp-buffer
274 (if (or (not search-limit)
275 (> search-limit (point-max)))
276 (setq search-limit (point-max)))
277 (flymake-log 3 "checking %s against regexp %s"
278 master-file-name regexp)
279 (goto-char (point-min))
280 (while (and (< (point) search-limit)
281 (re-search-forward regexp search-limit t))
282 (let ((match-beg (match-beginning 1))
283 (match-end (match-end 1)))
284
285 (flymake-log 3 "found possible match for %s" source-file-nondir)
286 (setq inc-name (match-string 1))
287 (and (> (length source-file-extension) 1)
288 (string-equal source-file-extension "tex")
289 (not (string-match (format "\\.%s\\'" source-file-extension)
290 inc-name))
291 (setq inc-name (concat inc-name "." source-file-extension)))
292 (when (eq t (compare-strings
293 source-file-nondir nil nil
294 inc-name (- (length inc-name)
295 (length source-file-nondir)) nil))
296 (flymake-log 3 "inc-name=%s" inc-name)
297 (when (flymake-check-include source-file-name inc-name
298 include-dirs)
299 (setq found t)
300 ;; replace-match is not used here as it fails in
301 ;; XEmacs with 'last match not a buffer' error as
302 ;; check-includes calls replace-in-string
303 (flymake-replace-region
304 match-beg match-end
305 (file-name-nondirectory patched-source-file-name))))
306 (forward-line 1)))
307 (when found
308 (flymake-save-buffer-in-file patched-master-file-name)))
309 ;;+(flymake-log 3 "killing buffer %s"
310 ;; (buffer-name master-file-temp-buffer))
311 (kill-buffer master-file-temp-buffer))
312 ;;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found)
313 (when found
314 (flymake-log 2 "found master file %s" master-file-name))
315 found))
316
317;;; XXX: remove
318(defun flymake-replace-region (beg end rep)
319 "Replace text in BUFFER in region (BEG END) with REP."
320 (save-excursion
321 (goto-char end)
322 ;; Insert before deleting, so as to better preserve markers's positions.
323 (insert rep)
324 (delete-region beg end)))
325
326(defun flymake-read-file-to-temp-buffer (file-name)
327 "Insert contents of FILE-NAME into newly created temp buffer."
328 (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name))))))
329 (with-current-buffer temp-buffer
330 (insert-file-contents file-name))
331 temp-buffer))
332
333(defun flymake-copy-buffer-to-temp-buffer (buffer)
334 "Copy contents of BUFFER into newly created temp buffer."
335 (with-current-buffer
336 (get-buffer-create (generate-new-buffer-name
337 (concat "flymake:" (buffer-name buffer))))
338 (insert-buffer-substring buffer)
339 (current-buffer)))
340
341(defun flymake-check-include (source-file-name inc-name include-dirs)
342 "Check if SOURCE-FILE-NAME can be found in include path.
343Return t if it can be found via include path using INC-NAME."
344 (if (file-name-absolute-p inc-name)
345 (flymake-same-files source-file-name inc-name)
346 (while (and include-dirs
347 (not (flymake-same-files
348 source-file-name
349 (concat (file-name-directory source-file-name)
350 "/" (car include-dirs)
351 "/" inc-name))))
352 (setq include-dirs (cdr include-dirs)))
353 include-dirs))
354
355(defun flymake-find-buffer-for-file (file-name)
356 "Check if there exists a buffer visiting FILE-NAME.
357Return t if so, nil if not."
358 (let ((buffer-name (get-file-buffer file-name)))
359 (if buffer-name
360 (get-buffer buffer-name))))
361
362(defun flymake-create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp)
363 "Save SOURCE-FILE-NAME with a different name.
364Find master file, patch and save it."
365 (let* ((possible-master-files (flymake-find-possible-master-files source-file-name flymake-master-file-dirs masks))
366 (master-file-count (length possible-master-files))
367 (idx 0)
368 (temp-buffer nil)
369 (master-file-name nil)
370 (patched-master-file-name nil)
371 (found nil))
372
373 (while (and (not found) (< idx master-file-count))
374 (setq master-file-name (nth idx possible-master-files))
375 (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master"))
376 (if (flymake-find-buffer-for-file master-file-name)
377 (setq temp-buffer (flymake-copy-buffer-to-temp-buffer (flymake-find-buffer-for-file master-file-name)))
378 (setq temp-buffer (flymake-read-file-to-temp-buffer master-file-name)))
379 (setq found
380 (flymake-check-patch-master-file-buffer
381 temp-buffer
382 master-file-name
383 patched-master-file-name
384 source-file-name
385 patched-source-file-name
386 (funcall get-incl-dirs-f (file-name-directory master-file-name))
387 include-regexp))
388 (setq idx (1+ idx)))
389 (if found
390 (list master-file-name patched-master-file-name)
391 (progn
392 (flymake-log 3 "none of %d master file(s) checked includes %s" master-file-count
393 (file-name-nondirectory source-file-name))
394 nil))))
395
396(defun flymake-save-buffer-in-file (file-name)
397 "Save the entire buffer contents into file FILE-NAME.
398Create parent directories as needed."
399 (make-directory (file-name-directory file-name) 1)
400 (write-region nil nil file-name nil 566)
401 (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name))
402
403(defun flymake-process-filter (process output)
404 "Parse OUTPUT and highlight error lines.
405It's flymake process filter."
406 (let ((source-buffer (process-buffer process)))
407
408 (flymake-log 3 "received %d byte(s) of output from process %d"
409 (length output) (process-id process))
410 (when (buffer-live-p source-buffer)
411 (with-current-buffer source-buffer
412 (flymake-parse-output-and-residual output)))))
413
414(defun flymake-process-sentinel (process _event)
415 "Sentinel for syntax check buffers."
416 (when (memq (process-status process) '(signal exit))
417 (let* ((exit-status (process-exit-status process))
418 (command (process-command process))
419 (source-buffer (process-buffer process))
420 (cleanup-f (flymake-get-cleanup-function (buffer-file-name source-buffer))))
421
422 (flymake-log 2 "process %d exited with code %d"
423 (process-id process) exit-status)
424 (condition-case err
425 (progn
426 (flymake-log 3 "cleaning up using %s" cleanup-f)
427 (when (buffer-live-p source-buffer)
428 (with-current-buffer source-buffer
429 (funcall cleanup-f)))
430
431 (delete-process process)
432 (setq flymake-processes (delq process flymake-processes))
433
434 (when (buffer-live-p source-buffer)
435 (with-current-buffer source-buffer
436
437 (flymake-parse-residual)
438 (flymake-post-syntax-check exit-status command)
439 (setq flymake-is-running nil))))
440 (error
441 (let ((err-str (format "Error in process sentinel for buffer %s: %s"
442 source-buffer (error-message-string err))))
443 (flymake-log 0 err-str)
444 (with-current-buffer source-buffer
445 (setq flymake-is-running nil))))))))
446
447(defun flymake-post-syntax-check (exit-status command)
448 (save-restriction
449 (widen)
450 (setq flymake-err-info flymake-new-err-info)
451 (setq flymake-new-err-info nil)
452 (setq flymake-err-info
453 (flymake-fix-line-numbers
454 flymake-err-info 1 (count-lines (point-min) (point-max))))
455 (flymake-delete-own-overlays)
456 (flymake-highlight-err-lines flymake-err-info)
457 (let (err-count warn-count)
458 (setq err-count (flymake-get-err-count flymake-err-info "e"))
459 (setq warn-count (flymake-get-err-count flymake-err-info "w"))
460 (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)"
461 (buffer-name) err-count warn-count
462 (- (float-time) flymake-check-start-time))
463 (setq flymake-check-start-time nil)
464
465 (if (and (equal 0 err-count) (equal 0 warn-count))
466 (if (equal 0 exit-status)
467 (flymake-report-status "" "") ; PASSED
468 (if (not flymake-check-was-interrupted)
469 (flymake-report-fatal-status "CFGERR"
470 (format "Configuration error has occurred while running %s" command))
471 (flymake-report-status nil ""))) ; "STOPPED"
472 (flymake-report-status (format "%d/%d" err-count warn-count) "")))))
473
474(defun flymake-parse-output-and-residual (output)
475 "Split OUTPUT into lines, merge in residual if necessary."
476 (let* ((buffer-residual flymake-output-residual)
477 (total-output (if buffer-residual (concat buffer-residual output) output))
478 (lines-and-residual (flymake-split-output total-output))
479 (lines (nth 0 lines-and-residual))
480 (new-residual (nth 1 lines-and-residual)))
481 (setq flymake-output-residual new-residual)
482 (setq flymake-new-err-info
483 (flymake-parse-err-lines
484 flymake-new-err-info lines))))
485
486(defun flymake-parse-residual ()
487 "Parse residual if it's non empty."
488 (when flymake-output-residual
489 (setq flymake-new-err-info
490 (flymake-parse-err-lines
491 flymake-new-err-info
492 (list flymake-output-residual)))
493 (setq flymake-output-residual nil)))
494
495(defun flymake-fix-line-numbers (err-info-list min-line max-line)
496 "Replace line numbers with fixed value.
497If line-numbers is less than MIN-LINE, set line numbers to MIN-LINE.
498If line numbers is greater than MAX-LINE, set line numbers to MAX-LINE.
499The reason for this fix is because some compilers might report
500line number outside the file being compiled."
501 (let* ((count (length err-info-list))
502 (err-info nil)
503 (line 0))
504 (while (> count 0)
505 (setq err-info (nth (1- count) err-info-list))
506 (setq line (flymake-er-get-line err-info))
507 (when (or (< line min-line) (> line max-line))
508 (setq line (if (< line min-line) min-line max-line))
509 (setq err-info-list (flymake-set-at err-info-list (1- count)
510 (flymake-er-make-er line
511 (flymake-er-get-line-err-info-list err-info)))))
512 (setq count (1- count))))
513 err-info-list)
514
515(defun flymake-parse-err-lines (err-info-list lines)
516 "Parse err LINES, store info in ERR-INFO-LIST."
517 (let* ((count (length lines))
518 (idx 0)
519 (line-err-info nil)
520 (real-file-name nil)
521 (source-file-name buffer-file-name)
522 (get-real-file-name-f (flymake-get-real-file-name-function source-file-name)))
523
524 (while (< idx count)
525 (setq line-err-info (flymake-parse-line (nth idx lines)))
526 (when line-err-info
527 (setq real-file-name (funcall get-real-file-name-f
528 (flymake-ler-file line-err-info)))
529 (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name))
530
531 (when (flymake-same-files real-file-name source-file-name)
532 (setq line-err-info (flymake-ler-set-file line-err-info nil))
533 (setq err-info-list (flymake-add-err-info err-info-list line-err-info))))
534 (flymake-log 3 "parsed `%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no"))
535 (setq idx (1+ idx)))
536 err-info-list))
537
538(defun flymake-split-output (output)
539 "Split OUTPUT into lines.
540Return last one as residual if it does not end with newline char.
541Returns ((LINES) RESIDUAL)."
542 (when (and output (> (length output) 0))
543 (let* ((lines (split-string output "[\n\r]+" t))
544 (complete (equal "\n" (char-to-string (aref output (1- (length output))))))
545 (residual nil))
546 (when (not complete)
547 (setq residual (car (last lines)))
548 (setq lines (butlast lines)))
549 (list lines residual))))
550
551(defun flymake-reformat-err-line-patterns-from-compile-el (original-list)
552 "Grab error line patterns from ORIGINAL-LIST in compile.el format.
553Convert it to flymake internal format."
554 (let* ((converted-list '()))
555 (dolist (item original-list)
556 (setq item (cdr item))
557 (let ((regexp (nth 0 item))
558 (file (nth 1 item))
559 (line (nth 2 item))
560 (col (nth 3 item)))
561 (if (consp file) (setq file (car file)))
562 (if (consp line) (setq line (car line)))
563 (if (consp col) (setq col (car col)))
564
565 (when (not (functionp line))
566 (setq converted-list (cons (list regexp file line col) converted-list)))))
567 converted-list))
568
569(require 'compile)
570
571(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text
572 (append
573 '(
574 ;; MS Visual C++ 6.0
575 ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
576 1 3 nil 4)
577 ;; jikes
578 ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)"
579 1 3 nil 4)
580 ;; MS midl
581 ("midl[ ]*:[ ]*\\(command line error .*\\)"
582 nil nil nil 1)
583 ;; MS C#
584 ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
585 1 3 nil 4)
586 ;; perl
587 ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1)
588 ;; PHP
589 ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1)
590 ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1)
591 ;; ant/javac. Note this also matches gcc warnings!
592 (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::[0-9]+\\)?:[ \t\n]*\\(.+\\)"
593 2 4 nil 5))
594 ;; compilation-error-regexp-alist)
595 (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist))
596 "Patterns for matching error/warning lines. Each pattern has the form
597\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX).
598Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns
599from compile.el")
600
601(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4")
602(defvar flymake-warning-predicate "^[wW]arning"
603 "Predicate matching against error text to detect a warning.
604Takes a single argument, the error's text and should return non-nil
605if it's a warning.
606Instead of a function, it can also be a regular expression.")
607
608(defun flymake-parse-line (line)
609 "Parse LINE to see if it is an error or warning.
610Return its components if so, nil otherwise."
611 (let ((raw-file-name nil)
612 (line-no 0)
613 (err-type "e")
614 (err-text nil)
615 (patterns flymake-err-line-patterns)
616 (matched nil))
617 (while (and patterns (not matched))
618 (when (string-match (car (car patterns)) line)
619 (let* ((file-idx (nth 1 (car patterns)))
620 (line-idx (nth 2 (car patterns))))
621
622 (setq raw-file-name (if file-idx (match-string file-idx line) nil))
623 (setq line-no (if line-idx (string-to-number
624 (match-string line-idx line)) 0))
625 (setq err-text (if (> (length (car patterns)) 4)
626 (match-string (nth 4 (car patterns)) line)
627 (flymake-patch-err-text
628 (substring line (match-end 0)))))
629 (if (null err-text)
630 (setq err-text "<no error text>")
631 (when (cond ((stringp flymake-warning-predicate)
632 (string-match flymake-warning-predicate err-text))
633 ((functionp flymake-warning-predicate)
634 (funcall flymake-warning-predicate err-text)))
635 (setq err-type "w")))
636 (flymake-log
637 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s"
638 file-idx line-idx raw-file-name line-no err-text)
639 (setq matched t)))
640 (setq patterns (cdr patterns)))
641 (if matched
642 (flymake-ler-make-ler raw-file-name line-no err-type err-text)
643 ())))
644
645(defun flymake-get-project-include-dirs-imp (basedir)
646 "Include dirs for the project current file belongs to."
647 (if (flymake-get-project-include-dirs-from-cache basedir)
648 (progn
649 (flymake-get-project-include-dirs-from-cache basedir))
650 ;;else
651 (let* ((command-line (concat "make -C "
652 (shell-quote-argument basedir)
653 " DUMPVARS=INCLUDE_DIRS dumpvars"))
654 (output (shell-command-to-string command-line))
655 (lines (split-string output "\n" t))
656 (count (length lines))
657 (idx 0)
658 (inc-dirs nil))
659 (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines))))
660 (setq idx (1+ idx)))
661 (when (< idx count)
662 (let* ((inc-lines (split-string (nth idx lines) " *-I" t))
663 (inc-count (length inc-lines)))
664 (while (> inc-count 0)
665 (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines)))
666 (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs))
667 (setq inc-count (1- inc-count)))))
668 (flymake-add-project-include-dirs-to-cache basedir inc-dirs)
669 inc-dirs)))
670
671(defvar flymake-get-project-include-dirs-function #'flymake-get-project-include-dirs-imp
672 "Function used to get project include dirs, one parameter: basedir name.")
673
674(defun flymake-get-project-include-dirs (basedir)
675 (funcall flymake-get-project-include-dirs-function basedir))
676
677(defun flymake-get-system-include-dirs ()
678 "System include dirs - from the `INCLUDE' env setting."
679 (let* ((includes (getenv "INCLUDE")))
680 (if includes (split-string includes path-separator t) nil)))
681
682(defvar flymake-project-include-dirs-cache (make-hash-table :test #'equal))
683
684(defun flymake-get-project-include-dirs-from-cache (base-dir)
685 (gethash base-dir flymake-project-include-dirs-cache))
686
687(defun flymake-add-project-include-dirs-to-cache (base-dir include-dirs)
688 (puthash base-dir include-dirs flymake-project-include-dirs-cache))
689
690(defun flymake-clear-project-include-dirs-cache ()
691 (clrhash flymake-project-include-dirs-cache))
692
693(defun flymake-get-include-dirs (base-dir)
694 "Get dirs to use when resolving local file names."
695 (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs))))
696 include-dirs))
697
698;; (defun flymake-restore-formatting ()
699;; "Remove any formatting made by flymake."
700;; )
701
702;; (defun flymake-get-program-dir (buffer)
703;; "Get dir to start program in."
704;; (unless (bufferp buffer)
705;; (error "Invalid buffer"))
706;; (with-current-buffer buffer
707;; default-directory))
708
709(defun flymake-safe-delete-file (file-name)
710 (when (and file-name (file-exists-p file-name))
711 (delete-file file-name)
712 (flymake-log 1 "deleted file %s" file-name)))
713
714(defun flymake-safe-delete-directory (dir-name)
715 (condition-case nil
716 (progn
717 (delete-directory dir-name)
718 (flymake-log 1 "deleted dir %s" dir-name))
719 (error
720 (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name))))
721
722(defun flymake-proc-start-syntax-check ()
723 "Start syntax checking for current buffer."
724 (interactive)
725 (flymake-log 3 "flymake is running: %s" flymake-is-running)
726 (when (not flymake-is-running)
727 (when (or (not flymake-compilation-prevents-syntax-check)
728 (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP")
729 (flymake-clear-buildfile-cache)
730 (flymake-clear-project-include-dirs-cache)
731
732 (setq flymake-check-was-interrupted nil)
733
734 (let* ((source-file-name buffer-file-name)
735 (init-f (flymake-get-init-function source-file-name))
736 (cleanup-f (flymake-get-cleanup-function source-file-name))
737 (cmd-and-args (funcall init-f))
738 (cmd (nth 0 cmd-and-args))
739 (args (nth 1 cmd-and-args))
740 (dir (nth 2 cmd-and-args)))
741 (if (not cmd-and-args)
742 (progn
743 (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name)
744 (funcall cleanup-f))
745 (progn
746 (setq flymake-last-change-time nil)
747 (flymake-start-syntax-check-process cmd args dir)))))))
748
749(defun flymake-start-syntax-check-process (cmd args dir)
750 "Start syntax check process."
751 (condition-case err
752 (let* ((process
753 (let ((default-directory (or dir default-directory)))
754 (when dir
755 (flymake-log 3 "starting process on dir %s" dir))
756 (apply 'start-file-process
757 "flymake-proc" (current-buffer) cmd args))))
758 (set-process-sentinel process 'flymake-process-sentinel)
759 (set-process-filter process 'flymake-process-filter)
760 (set-process-query-on-exit-flag process nil)
761 (push process flymake-processes)
762
763 (setq flymake-is-running t)
764 (setq flymake-last-change-time nil)
765 (setq flymake-check-start-time (float-time))
766
767 (flymake-report-status nil "*")
768 (flymake-log 2 "started process %d, command=%s, dir=%s"
769 (process-id process) (process-command process)
770 default-directory)
771 process)
772 (error
773 (let* ((err-str
774 (format-message
775 "Failed to launch syntax check process `%s' with args %s: %s"
776 cmd args (error-message-string err)))
777 (source-file-name buffer-file-name)
778 (cleanup-f (flymake-get-cleanup-function source-file-name)))
779 (flymake-log 0 err-str)
780 (funcall cleanup-f)
781 (flymake-report-fatal-status "PROCERR" err-str)))))
782
783(defun flymake-kill-process (proc)
784 "Kill process PROC."
785 (kill-process proc)
786 (let* ((buf (process-buffer proc)))
787 (when (buffer-live-p buf)
788 (with-current-buffer buf
789 (setq flymake-check-was-interrupted t))))
790 (flymake-log 1 "killed process %d" (process-id proc)))
791
792(defun flymake-stop-all-syntax-checks ()
793 "Kill all syntax check processes."
794 (interactive)
795 (while flymake-processes
796 (flymake-kill-process (pop flymake-processes))))
797
798(defun flymake-compilation-is-running ()
799 (and (boundp 'compilation-in-progress)
800 compilation-in-progress))
801
802(defun flymake-compile ()
803 "Kill all flymake syntax checks, start compilation."
804 (interactive)
805 (flymake-stop-all-syntax-checks)
806 (call-interactively 'compile))
807
808;;;; general init-cleanup and helper routines
809(defun flymake-create-temp-inplace (file-name prefix)
810 (unless (stringp file-name)
811 (error "Invalid file-name"))
812 (or prefix
813 (setq prefix "flymake"))
814 (let* ((ext (file-name-extension file-name))
815 (temp-name (file-truename
816 (concat (file-name-sans-extension file-name)
817 "_" prefix
818 (and ext (concat "." ext))))))
819 (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name)
820 temp-name))
821
822(defun flymake-create-temp-with-folder-structure (file-name _prefix)
823 (unless (stringp file-name)
824 (error "Invalid file-name"))
825
826 (let* ((dir (file-name-directory file-name))
827 ;; Not sure what this slash-pos is all about, but I guess it's just
828 ;; trying to remove the leading / of absolute file names.
829 (slash-pos (string-match "/" dir))
830 (temp-dir (expand-file-name (substring dir (1+ slash-pos))
831 temporary-file-directory)))
832
833 (file-truename (expand-file-name (file-name-nondirectory file-name)
834 temp-dir))))
835
836(defun flymake-delete-temp-directory (dir-name)
837 "Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error."
838 (let* ((temp-dir temporary-file-directory)
839 (suffix (substring dir-name (1+ (length temp-dir)))))
840
841 (while (> (length suffix) 0)
842 (setq suffix (directory-file-name suffix))
843 ;;+(flymake-log 0 "suffix=%s" suffix)
844 (flymake-safe-delete-directory
845 (file-truename (expand-file-name suffix temp-dir)))
846 (setq suffix (file-name-directory suffix)))))
847
848(defvar-local flymake-temp-source-file-name nil)
849(defvar-local flymake-master-file-name nil)
850(defvar-local flymake-temp-master-file-name nil)
851(defvar-local flymake-base-dir nil)
852
853(defun flymake-init-create-temp-buffer-copy (create-temp-f)
854 "Make a temporary copy of the current buffer, save its name in buffer data and return the name."
855 (let* ((source-file-name buffer-file-name)
856 (temp-source-file-name (funcall create-temp-f source-file-name "flymake")))
857
858 (flymake-save-buffer-in-file temp-source-file-name)
859 (setq flymake-temp-source-file-name temp-source-file-name)
860 temp-source-file-name))
861
862(defun flymake-simple-cleanup ()
863 "Do cleanup after `flymake-init-create-temp-buffer-copy'.
864Delete temp file."
865 (flymake-safe-delete-file flymake-temp-source-file-name)
866 (setq flymake-last-change-time nil))
867
868(defun flymake-get-real-file-name (file-name-from-err-msg)
869 "Translate file name from error message to \"real\" file name.
870Return full-name. Names are real, not patched."
871 (let* ((real-name nil)
872 (source-file-name buffer-file-name)
873 (master-file-name flymake-master-file-name)
874 (temp-source-file-name flymake-temp-source-file-name)
875 (temp-master-file-name flymake-temp-master-file-name)
876 (base-dirs
877 (list flymake-base-dir
878 (file-name-directory source-file-name)
879 (if master-file-name (file-name-directory master-file-name))))
880 (files (list (list source-file-name source-file-name)
881 (list temp-source-file-name source-file-name)
882 (list master-file-name master-file-name)
883 (list temp-master-file-name master-file-name))))
884
885 (when (equal 0 (length file-name-from-err-msg))
886 (setq file-name-from-err-msg source-file-name))
887
888 (setq real-name (flymake-get-full-patched-file-name file-name-from-err-msg base-dirs files))
889 ;; if real-name is nil, than file name from err msg is none of the files we've patched
890 (if (not real-name)
891 (setq real-name (flymake-get-full-nonpatched-file-name file-name-from-err-msg base-dirs)))
892 (if (not real-name)
893 (setq real-name file-name-from-err-msg))
894 (setq real-name (flymake-fix-file-name real-name))
895 (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name)
896 real-name))
897
898(defun flymake-get-full-patched-file-name (file-name-from-err-msg base-dirs files)
899 (let* ((base-dirs-count (length base-dirs))
900 (file-count (length files))
901 (real-name nil))
902
903 (while (and (not real-name) (> base-dirs-count 0))
904 (setq file-count (length files))
905 (while (and (not real-name) (> file-count 0))
906 (let* ((this-dir (nth (1- base-dirs-count) base-dirs))
907 (this-file (nth 0 (nth (1- file-count) files)))
908 (this-real-name (nth 1 (nth (1- file-count) files))))
909 ;;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg)
910 (when (and this-dir this-file (flymake-same-files
911 (expand-file-name file-name-from-err-msg this-dir)
912 this-file))
913 (setq real-name this-real-name)))
914 (setq file-count (1- file-count)))
915 (setq base-dirs-count (1- base-dirs-count)))
916 real-name))
917
918(defun flymake-get-full-nonpatched-file-name (file-name-from-err-msg base-dirs)
919 (let* ((real-name nil))
920 (if (file-name-absolute-p file-name-from-err-msg)
921 (setq real-name file-name-from-err-msg)
922 (let* ((base-dirs-count (length base-dirs)))
923 (while (and (not real-name) (> base-dirs-count 0))
924 (let* ((full-name (expand-file-name file-name-from-err-msg
925 (nth (1- base-dirs-count) base-dirs))))
926 (if (file-exists-p full-name)
927 (setq real-name full-name))
928 (setq base-dirs-count (1- base-dirs-count))))))
929 real-name))
930
931(defun flymake-init-find-buildfile-dir (source-file-name buildfile-name)
932 "Find buildfile, store its dir in buffer data and return its dir, if found."
933 (let* ((buildfile-dir
934 (flymake-find-buildfile buildfile-name
935 (file-name-directory source-file-name))))
936 (if buildfile-dir
937 (setq flymake-base-dir buildfile-dir)
938 (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name)
939 (flymake-report-fatal-status
940 "NOMK" (format "No buildfile (%s) found for %s"
941 buildfile-name source-file-name)))))
942
943(defun flymake-init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp)
944 "Find master file (or buffer), create its copy along with a copy of the source file."
945 (let* ((source-file-name buffer-file-name)
946 (temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f))
947 (master-and-temp-master (flymake-create-master-file
948 source-file-name temp-source-file-name
949 get-incl-dirs-f create-temp-f
950 master-file-masks include-regexp)))
951
952 (if (not master-and-temp-master)
953 (progn
954 (flymake-log 1 "cannot find master file for %s" source-file-name)
955 (flymake-report-status "!" "") ; NOMASTER
956 nil)
957 (setq flymake-master-file-name (nth 0 master-and-temp-master))
958 (setq flymake-temp-master-file-name (nth 1 master-and-temp-master)))))
959
960(defun flymake-master-cleanup ()
961 (flymake-simple-cleanup)
962 (flymake-safe-delete-file flymake-temp-master-file-name))
963
964;;;; make-specific init-cleanup routines
965(defun flymake-get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f)
966 "Create a command line for syntax check using GET-CMD-LINE-F."
967 (funcall get-cmd-line-f
968 (if use-relative-source
969 (file-relative-name source-file-name base-dir)
970 source-file-name)
971 (if use-relative-base-dir
972 (file-relative-name base-dir
973 (file-name-directory source-file-name))
974 base-dir)))
975
976(defun flymake-get-make-cmdline (source base-dir)
977 (list "make"
978 (list "-s"
979 "-C"
980 base-dir
981 (concat "CHK_SOURCES=" source)
982 "SYNTAX_CHECK_MODE=1"
983 "check-syntax")))
984
985(defun flymake-get-ant-cmdline (source base-dir)
986 (list "ant"
987 (list "-buildfile"
988 (concat base-dir "/" "build.xml")
989 (concat "-DCHK_SOURCES=" source)
990 "check-syntax")))
991
992(defun flymake-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f)
993 "Create syntax check command line for a directly checked source file.
994Use CREATE-TEMP-F for creating temp copy."
995 (let* ((args nil)
996 (source-file-name buffer-file-name)
997 (buildfile-dir (flymake-init-find-buildfile-dir source-file-name build-file-name)))
998 (if buildfile-dir
999 (let* ((temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f)))
1000 (setq args (flymake-get-syntax-check-program-args temp-source-file-name buildfile-dir
1001 use-relative-base-dir use-relative-source
1002 get-cmdline-f))))
1003 args))
1004
1005(defun flymake-simple-make-init ()
1006 (flymake-simple-make-init-impl 'flymake-create-temp-inplace t t "Makefile" 'flymake-get-make-cmdline))
1007
1008(defun flymake-master-make-init (get-incl-dirs-f master-file-masks include-regexp)
1009 "Create make command line for a source file checked via master file compilation."
1010 (let* ((make-args nil)
1011 (temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy
1012 get-incl-dirs-f 'flymake-create-temp-inplace
1013 master-file-masks include-regexp)))
1014 (when temp-master-file-name
1015 (let* ((buildfile-dir (flymake-init-find-buildfile-dir temp-master-file-name "Makefile")))
1016 (if buildfile-dir
1017 (setq make-args (flymake-get-syntax-check-program-args
1018 temp-master-file-name buildfile-dir nil nil 'flymake-get-make-cmdline)))))
1019 make-args))
1020
1021(defun flymake-find-make-buildfile (source-dir)
1022 (flymake-find-buildfile "Makefile" source-dir))
1023
1024;;;; .h/make specific
1025(defun flymake-master-make-header-init ()
1026 (flymake-master-make-init
1027 'flymake-get-include-dirs
1028 '("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'")
1029 "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\""))
1030
1031;;;; .java/make specific
1032(defun flymake-simple-make-java-init ()
1033 (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "Makefile" 'flymake-get-make-cmdline))
1034
1035(defun flymake-simple-ant-java-init ()
1036 (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "build.xml" 'flymake-get-ant-cmdline))
1037
1038(defun flymake-simple-java-cleanup ()
1039 "Cleanup after `flymake-simple-make-java-init' -- delete temp file and dirs."
1040 (flymake-safe-delete-file flymake-temp-source-file-name)
1041 (when flymake-temp-source-file-name
1042 (flymake-delete-temp-directory
1043 (file-name-directory flymake-temp-source-file-name))))
1044
1045;;;; perl-specific init-cleanup routines
1046(defun flymake-perl-init ()
1047 (let* ((temp-file (flymake-init-create-temp-buffer-copy
1048 'flymake-create-temp-inplace))
1049 (local-file (file-relative-name
1050 temp-file
1051 (file-name-directory buffer-file-name))))
1052 (list "perl" (list "-wc " local-file))))
1053
1054;;;; php-specific init-cleanup routines
1055(defun flymake-php-init ()
1056 (let* ((temp-file (flymake-init-create-temp-buffer-copy
1057 'flymake-create-temp-inplace))
1058 (local-file (file-relative-name
1059 temp-file
1060 (file-name-directory buffer-file-name))))
1061 (list "php" (list "-f" local-file "-l"))))
1062
1063;;;; tex-specific init-cleanup routines
1064(defun flymake-get-tex-args (file-name)
1065 ;;(list "latex" (list "-c-style-errors" file-name))
1066 (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name)))
1067
1068(defun flymake-simple-tex-init ()
1069 (flymake-get-tex-args (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace)))
1070
1071;; Perhaps there should be a buffer-local variable flymake-master-file
1072;; that people can set to override this stuff. Could inherit from
1073;; the similar AUCTeX variable.
1074(defun flymake-master-tex-init ()
1075 (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy
1076 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace
1077 '("\\.tex\\'")
1078 "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}")))
1079 (when temp-master-file-name
1080 (flymake-get-tex-args temp-master-file-name))))
1081
1082(defun flymake-get-include-dirs-dot (_base-dir)
1083 '("."))
1084
1085;;;; xml-specific init-cleanup routines
1086(defun flymake-xml-init ()
1087 (list flymake-xml-program
1088 (list "val" (flymake-init-create-temp-buffer-copy
1089 'flymake-create-temp-inplace))))
1090
1091
1092;;;; Hook onto flymake-ui
1093
1094(add-to-list 'flymake-backends
1095 `(flymake-proc-can-syntax-check-buffer
1096 .
1097 flymake-proc-start-syntax-check))
1098
1099(provide 'flymake-proc)
1100;;; flymake-proc.el ends here
diff --git a/lisp/progmodes/flymake-ui.el b/lisp/progmodes/flymake-ui.el
deleted file mode 100644
index bf5218c41d2..00000000000
--- a/lisp/progmodes/flymake-ui.el
+++ /dev/null
@@ -1,634 +0,0 @@
1;;; flymake-ui.el --- A universal on-the-fly syntax checker -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2003-2017 Free Software Foundation, Inc.
4
5;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
6;; Maintainer: Leo Liu <sdl.web@gmail.com>
7;; Version: 0.3
8;; Keywords: c languages tools
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
24
25;;; Commentary:
26;;
27;; Flymake is a minor Emacs mode performing on-the-fly syntax checks.xo
28;;
29;; This file contains the UI for displaying and interacting with the
30;; results of such checks, as well as entry points for backends to
31;; hook on to. Backends are sources of diagnostic info.
32;;
33;;; Code:
34
35(eval-when-compile (require 'cl-lib))
36
37(defgroup flymake nil
38 "Universal on-the-fly syntax checker."
39 :version "23.1"
40 :link '(custom-manual "(flymake) Top")
41 :group 'tools)
42
43(defcustom flymake-error-bitmap '(exclamation-mark error)
44 "Bitmap (a symbol) used in the fringe for indicating errors.
45The value may also be a list of two elements where the second
46element specifies the face for the bitmap. For possible bitmap
47symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'.
48
49The option `flymake-fringe-indicator-position' controls how and where
50this is used."
51 :group 'flymake
52 :version "24.3"
53 :type '(choice (symbol :tag "Bitmap")
54 (list :tag "Bitmap and face"
55 (symbol :tag "Bitmap")
56 (face :tag "Face"))))
57
58(defcustom flymake-warning-bitmap 'question-mark
59 "Bitmap (a symbol) used in the fringe for indicating warnings.
60The value may also be a list of two elements where the second
61element specifies the face for the bitmap. For possible bitmap
62symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'.
63
64The option `flymake-fringe-indicator-position' controls how and where
65this is used."
66 :group 'flymake
67 :version "24.3"
68 :type '(choice (symbol :tag "Bitmap")
69 (list :tag "Bitmap and face"
70 (symbol :tag "Bitmap")
71 (face :tag "Face"))))
72
73(defcustom flymake-fringe-indicator-position 'left-fringe
74 "The position to put flymake fringe indicator.
75The value can be nil (do not use indicators), `left-fringe' or `right-fringe'.
76See `flymake-error-bitmap' and `flymake-warning-bitmap'."
77 :group 'flymake
78 :version "24.3"
79 :type '(choice (const left-fringe)
80 (const right-fringe)
81 (const :tag "No fringe indicators" nil)))
82
83(defcustom flymake-start-syntax-check-on-newline t
84 "Start syntax check if newline char was added/removed from the buffer."
85 :group 'flymake
86 :type 'boolean)
87
88(defcustom flymake-no-changes-timeout 0.5
89 "Time to wait after last change before starting compilation."
90 :group 'flymake
91 :type 'number)
92
93(defcustom flymake-gui-warnings-enabled t
94 "Enables/disables GUI warnings."
95 :group 'flymake
96 :type 'boolean)
97(make-obsolete-variable 'flymake-gui-warnings-enabled
98 "it no longer has any effect." "26.1")
99
100(defcustom flymake-start-syntax-check-on-find-file t
101 "Start syntax check on find file."
102 :group 'flymake
103 :type 'boolean)
104
105(defcustom flymake-log-level -1
106 "Logging level, only messages with level lower or equal will be logged.
107-1 = NONE, 0 = ERROR, 1 = WARNING, 2 = INFO, 3 = DEBUG"
108 :group 'flymake
109 :type 'integer)
110
111(defcustom flymake-backends '()
112 "Ordered list of backends providing syntax check information for a buffer.
113Value is an alist of conses (PREDICATE . CHECKER). Both PREDICATE
114and CHECKER are functions called with a single argument, the
115buffer in which `flymake-mode' was enabled. PREDICATE is expected
116to (quickly) return t or nil if the buffer can be syntax checked
117by CHECKER, which in can performs more morose operations,
118possibly asynchronously."
119 :group 'flymake
120 :type 'alist)
121
122(defvar-local flymake-timer nil
123 "Timer for starting syntax check.")
124
125(defvar-local flymake-last-change-time nil
126 "Time of last buffer change.")
127
128(defvar-local flymake-check-start-time nil
129 "Time at which syntax check was started.")
130
131(defvar-local flymake-check-was-interrupted nil
132 "Non-nil if syntax check was killed by `flymake-compile'.")
133
134(defvar-local flymake-err-info nil
135 "Sorted list of line numbers and lists of err info in the form (file, err-text).")
136
137(defvar-local flymake-new-err-info nil
138 "Same as `flymake-err-info', effective when a syntax check is in progress.")
139
140(defun flymake-log (level text &rest args)
141 "Log a message at level LEVEL.
142If LEVEL is higher than `flymake-log-level', the message is
143ignored. Otherwise, it is printed using `message'.
144TEXT is a format control string, and the remaining arguments ARGS
145are the string substitutions (see the function `format')."
146 (if (<= level flymake-log-level)
147 (let* ((msg (apply #'format-message text args)))
148 (message "%s" msg))))
149
150(defun flymake-ins-after (list pos val)
151 "Insert VAL into LIST after position POS.
152POS counts from zero."
153 (let ((tmp (copy-sequence list)))
154 (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp)))
155 tmp))
156
157(defun flymake-set-at (list pos val)
158 "Set VAL at position POS in LIST.
159POS counts from zero."
160 (let ((tmp (copy-sequence list)))
161 (setcar (nthcdr pos tmp) val)
162 tmp))
163
164(defun flymake-er-make-er (line-no line-err-info-list)
165 (list line-no line-err-info-list))
166
167(defun flymake-er-get-line (err-info)
168 (nth 0 err-info))
169
170(defun flymake-er-get-line-err-info-list (err-info)
171 (nth 1 err-info))
172
173(cl-defstruct (flymake-ler
174 (:constructor nil)
175 (:constructor flymake-ler-make-ler (file line type text &optional full-file)))
176 file line type text full-file)
177
178(defun flymake-ler-set-file (line-err-info file)
179 (flymake-ler-make-ler file
180 (flymake-ler-line line-err-info)
181 (flymake-ler-type line-err-info)
182 (flymake-ler-text line-err-info)
183 (flymake-ler-full-file line-err-info)))
184
185(defun flymake-ler-set-full-file (line-err-info full-file)
186 (flymake-ler-make-ler (flymake-ler-file line-err-info)
187 (flymake-ler-line line-err-info)
188 (flymake-ler-type line-err-info)
189 (flymake-ler-text line-err-info)
190 full-file))
191
192(defun flymake-ler-set-line (line-err-info line)
193 (flymake-ler-make-ler (flymake-ler-file line-err-info)
194 line
195 (flymake-ler-type line-err-info)
196 (flymake-ler-text line-err-info)
197 (flymake-ler-full-file line-err-info)))
198
199(defun flymake-get-line-err-count (line-err-info-list type)
200 "Return number of errors of specified TYPE.
201Value of TYPE is either \"e\" or \"w\"."
202 (let* ((idx 0)
203 (count (length line-err-info-list))
204 (err-count 0))
205
206 (while (< idx count)
207 (when (equal type (flymake-ler-type (nth idx line-err-info-list)))
208 (setq err-count (1+ err-count)))
209 (setq idx (1+ idx)))
210 err-count))
211
212(defun flymake-get-err-count (err-info-list type)
213 "Return number of errors of specified TYPE for ERR-INFO-LIST."
214 (let* ((idx 0)
215 (count (length err-info-list))
216 (err-count 0))
217 (while (< idx count)
218 (setq err-count (+ err-count (flymake-get-line-err-count (nth 1 (nth idx err-info-list)) type)))
219 (setq idx (1+ idx)))
220 err-count))
221
222(defun flymake-highlight-err-lines (err-info-list)
223 "Highlight error lines in BUFFER using info from ERR-INFO-LIST."
224 (save-excursion
225 (dolist (err err-info-list)
226 (flymake-highlight-line (car err) (nth 1 err)))))
227
228(defun flymake-overlay-p (ov)
229 "Determine whether overlay OV was created by flymake."
230 (and (overlayp ov) (overlay-get ov 'flymake-overlay)))
231
232(defun flymake-make-overlay (beg end tooltip-text face bitmap)
233 "Allocate a flymake overlay in range BEG and END."
234 (when (not (flymake-region-has-flymake-overlays beg end))
235 (let ((ov (make-overlay beg end nil t))
236 (fringe (and flymake-fringe-indicator-position
237 (propertize "!" 'display
238 (cons flymake-fringe-indicator-position
239 (if (listp bitmap)
240 bitmap
241 (list bitmap)))))))
242 (overlay-put ov 'face face)
243 (overlay-put ov 'help-echo tooltip-text)
244 (overlay-put ov 'flymake-overlay t)
245 (overlay-put ov 'priority 100)
246 (overlay-put ov 'evaporate t)
247 (overlay-put ov 'before-string fringe)
248 ;;+(flymake-log 3 "created overlay %s" ov)
249 ov)
250 (flymake-log 3 "created an overlay at (%d-%d)" beg end)))
251
252(defun flymake-delete-own-overlays ()
253 "Delete all flymake overlays in BUFFER."
254 (dolist (ol (overlays-in (point-min) (point-max)))
255 (when (flymake-overlay-p ol)
256 (delete-overlay ol)
257 ;;+(flymake-log 3 "deleted overlay %s" ol)
258 )))
259
260(defun flymake-region-has-flymake-overlays (beg end)
261 "Check if region specified by BEG and END has overlay.
262Return t if it has at least one flymake overlay, nil if no overlay."
263 (let ((ov (overlays-in beg end))
264 (has-flymake-overlays nil))
265 (while (consp ov)
266 (when (flymake-overlay-p (car ov))
267 (setq has-flymake-overlays t))
268 (setq ov (cdr ov)))
269 has-flymake-overlays))
270
271(defface flymake-errline
272 '((((supports :underline (:style wave)))
273 :underline (:style wave :color "Red1"))
274 (t
275 :inherit error))
276 "Face used for marking error lines."
277 :version "24.4"
278 :group 'flymake)
279
280(defface flymake-warnline
281 '((((supports :underline (:style wave)))
282 :underline (:style wave :color "DarkOrange"))
283 (t
284 :inherit warning))
285 "Face used for marking warning lines."
286 :version "24.4"
287 :group 'flymake)
288
289(defun flymake-highlight-line (line-no line-err-info-list)
290 "Highlight line LINE-NO in current buffer.
291Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting."
292 (goto-char (point-min))
293 (forward-line (1- line-no))
294 (pcase-let* ((beg (progn (back-to-indentation) (point)))
295 (end (progn
296 (end-of-line)
297 (skip-chars-backward " \t\f\t\n" beg)
298 (if (eq (point) beg)
299 (line-beginning-position 2)
300 (point))))
301 (tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n"))
302 (`(,face ,bitmap)
303 (if (> (flymake-get-line-err-count line-err-info-list "e") 0)
304 (list 'flymake-errline flymake-error-bitmap)
305 (list 'flymake-warnline flymake-warning-bitmap))))
306 (flymake-make-overlay beg end tooltip-text face bitmap)))
307
308(defun flymake-find-err-info (err-info-list line-no)
309 "Find (line-err-info-list pos) for specified LINE-NO."
310 (if err-info-list
311 (let* ((line-err-info-list nil)
312 (pos 0)
313 (count (length err-info-list)))
314
315 (while (and (< pos count) (< (car (nth pos err-info-list)) line-no))
316 (setq pos (1+ pos)))
317 (when (and (< pos count) (equal (car (nth pos err-info-list)) line-no))
318 (setq line-err-info-list (flymake-er-get-line-err-info-list (nth pos err-info-list))))
319 (list line-err-info-list pos))
320 '(nil 0)))
321
322(defun flymake-line-err-info-is-less-or-equal (line-one line-two)
323 (or (string< (flymake-ler-type line-one) (flymake-ler-type line-two))
324 (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two))
325 (not (flymake-ler-file line-one)) (flymake-ler-file line-two))
326 (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two))
327 (or (and (flymake-ler-file line-one) (flymake-ler-file line-two))
328 (and (not (flymake-ler-file line-one)) (not (flymake-ler-file line-two)))))))
329
330(defun flymake-add-line-err-info (line-err-info-list line-err-info)
331 "Update LINE-ERR-INFO-LIST with the error LINE-ERR-INFO.
332For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'.
333The new element is inserted in the proper position, according to
334the predicate `flymake-line-err-info-is-less-or-equal'.
335The updated value of LINE-ERR-INFO-LIST is returned."
336 (if (not line-err-info-list)
337 (list line-err-info)
338 (let* ((count (length line-err-info-list))
339 (idx 0))
340 (while (and (< idx count) (flymake-line-err-info-is-less-or-equal (nth idx line-err-info-list) line-err-info))
341 (setq idx (1+ idx)))
342 (cond ((equal 0 idx) (setq line-err-info-list (cons line-err-info line-err-info-list)))
343 (t (setq line-err-info-list (flymake-ins-after line-err-info-list (1- idx) line-err-info))))
344 line-err-info-list)))
345
346(defun flymake-add-err-info (err-info-list line-err-info)
347 "Update ERR-INFO-LIST with the error LINE-ERR-INFO, preserving sort order.
348Returns the updated value of ERR-INFO-LIST.
349For the format of ERR-INFO-LIST, see `flymake-err-info'.
350For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
351 (let* ((line-no (if (flymake-ler-file line-err-info) 1 (flymake-ler-line line-err-info)))
352 (info-and-pos (flymake-find-err-info err-info-list line-no))
353 (exists (car info-and-pos))
354 (pos (nth 1 info-and-pos))
355 (line-err-info-list nil)
356 (err-info nil))
357
358 (if exists
359 (setq line-err-info-list (flymake-er-get-line-err-info-list (car (nthcdr pos err-info-list)))))
360 (setq line-err-info-list (flymake-add-line-err-info line-err-info-list line-err-info))
361
362 (setq err-info (flymake-er-make-er line-no line-err-info-list))
363 (cond (exists (setq err-info-list (flymake-set-at err-info-list pos err-info)))
364 ((equal 0 pos) (setq err-info-list (cons err-info err-info-list)))
365 (t (setq err-info-list (flymake-ins-after err-info-list (1- pos) err-info))))
366 err-info-list))
367
368(defvar-local flymake-is-running nil
369 "If t, flymake syntax check process is running for the current buffer.")
370
371(defun flymake-on-timer-event (buffer)
372 "Start a syntax check for buffer BUFFER if necessary."
373 (when (buffer-live-p buffer)
374 (with-current-buffer buffer
375 (when (and (not flymake-is-running)
376 flymake-last-change-time
377 (> (- (float-time) flymake-last-change-time)
378 flymake-no-changes-timeout))
379
380 (setq flymake-last-change-time nil)
381 (flymake-log 3 "starting syntax check as more than 1 second passed since last change")
382 (flymake--start-syntax-check)))))
383
384(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line
385 'flymake-popup-current-error-menu "24.4")
386
387(defun flymake-popup-current-error-menu (&optional event)
388 "Pop up a menu with errors/warnings for current line."
389 (interactive (list last-nonmenu-event))
390 (let* ((line-no (line-number-at-pos))
391 (errors (or (car (flymake-find-err-info flymake-err-info line-no))
392 (user-error "No errors for current line")))
393 (menu (mapcar (lambda (x)
394 (if (flymake-ler-file x)
395 (cons (format "%s - %s(%d)"
396 (flymake-ler-text x)
397 (flymake-ler-file x)
398 (flymake-ler-line x))
399 x)
400 (list (flymake-ler-text x))))
401 errors))
402 (event (if (mouse-event-p event)
403 event
404 (list 'mouse-1 (posn-at-point))))
405 (title (format "Line %d: %d error(s), %d warning(s)"
406 line-no
407 (flymake-get-line-err-count errors "e")
408 (flymake-get-line-err-count errors "w")))
409 (choice (x-popup-menu event (list title (cons "" menu)))))
410 (flymake-log 3 "choice=%s" choice)
411 (when choice
412 (flymake-goto-file-and-line (flymake-ler-full-file choice)
413 (flymake-ler-line choice)))))
414
415(defun flymake-goto-file-and-line (file line)
416 "Try to get buffer for FILE and goto line LINE in it."
417 (if (not (file-exists-p file))
418 (flymake-log 1 "File %s does not exist" file)
419 (find-file file)
420 (goto-char (point-min))
421 (forward-line (1- line))))
422
423;; flymake minor mode declarations
424(defvar-local flymake-mode-line nil)
425(defvar-local flymake-mode-line-e-w nil)
426(defvar-local flymake-mode-line-status nil)
427
428(defun flymake-report-status (e-w &optional status)
429 "Show status in mode line."
430 (when e-w
431 (setq flymake-mode-line-e-w e-w))
432 (when status
433 (setq flymake-mode-line-status status))
434 (let* ((mode-line " Flymake"))
435 (when (> (length flymake-mode-line-e-w) 0)
436 (setq mode-line (concat mode-line ":" flymake-mode-line-e-w)))
437 (setq mode-line (concat mode-line flymake-mode-line-status))
438 (setq flymake-mode-line mode-line)
439 (force-mode-line-update)))
440
441;; Nothing in flymake uses this at all any more, so this is just for
442;; third-party compatibility.
443(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1")
444
445(defun flymake-report-fatal-status (status warning)
446 "Display a warning and switch flymake mode off."
447 ;; This first message was always shown by default, and flymake-log
448 ;; does nothing by default, hence the use of message.
449 ;; Another option is display-warning.
450 (if (< flymake-log-level 0)
451 (message "Flymake: %s. Flymake will be switched OFF" warning))
452 (flymake-mode 0)
453 (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s"
454 (buffer-name) status warning))
455
456(defvar-local flymake--backend nil
457 "The currently active backend selected by `flymake-mode'")
458
459(defun flymake--can-syntax-check-buffer (buffer)
460 (let ((all flymake-backends)
461 (candidate))
462 (catch 'done
463 (while (setq candidate (pop all))
464 (when (with-current-buffer buffer (funcall (car candidate)))
465 (throw 'done (cdr candidate)))))))
466
467(defun flymake--start-syntax-check ()
468 (funcall flymake--backend))
469
470;;;###autoload
471(define-minor-mode flymake-mode nil
472 :group 'flymake :lighter flymake-mode-line
473 (cond
474
475 ;; Turning the mode ON.
476 (flymake-mode
477 (let* ((backend (flymake--can-syntax-check-buffer (current-buffer))))
478 (cond
479 ((not backend)
480 (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name)))
481 (t
482 (setq flymake--backend backend)
483
484 (add-hook 'after-change-functions 'flymake-after-change-function nil t)
485 (add-hook 'after-save-hook 'flymake-after-save-hook nil t)
486 (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
487 ;;+(add-hook 'find-file-hook 'flymake-find-file-hook)
488
489 (flymake-report-status "" "")
490
491 (setq flymake-timer
492 (run-at-time nil 1 'flymake-on-timer-event (current-buffer)))
493
494 (when (and flymake-start-syntax-check-on-find-file
495 ;; Since we write temp files in current dir, there's no point
496 ;; trying if the directory is read-only (bug#8954).
497 (file-writable-p (file-name-directory buffer-file-name)))
498 (with-demoted-errors
499 (flymake--start-syntax-check)))))
500 )
501 )
502
503 ;; Turning the mode OFF.
504 (t
505 (setq flymake--backend nil)
506
507 (remove-hook 'after-change-functions 'flymake-after-change-function t)
508 (remove-hook 'after-save-hook 'flymake-after-save-hook t)
509 (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t)
510 ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t)
511
512 (flymake-delete-own-overlays)
513
514 (when flymake-timer
515 (cancel-timer flymake-timer)
516 (setq flymake-timer nil))
517
518 (setq flymake-is-running nil))))
519
520;; disabling flymake-mode is safe, enabling - not necessarily so
521(put 'flymake-mode 'safe-local-variable 'null)
522
523;;;###autoload
524(defun flymake-mode-on ()
525 "Turn flymake mode on."
526 (flymake-mode 1)
527 (flymake-log 1 "flymake mode turned ON for buffer %s" (buffer-name)))
528
529;;;###autoload
530(defun flymake-mode-off ()
531 "Turn flymake mode off."
532 (flymake-mode 0)
533 (flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name)))
534
535(defun flymake-after-change-function (start stop _len)
536 "Start syntax check for current buffer if it isn't already running."
537 ;;+(flymake-log 0 "setting change time to %s" (float-time))
538 (let((new-text (buffer-substring start stop)))
539 (when (and flymake-start-syntax-check-on-newline (equal new-text "\n"))
540 (flymake-log 3 "starting syntax check as new-line has been seen")
541 (flymake--start-syntax-check))
542 (setq flymake-last-change-time (float-time))))
543
544(defun flymake-after-save-hook ()
545 (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved?
546 (progn
547 (flymake-log 3 "starting syntax check as buffer was saved")
548 (flymake--start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???)
549
550(defun flymake-kill-buffer-hook ()
551 (when flymake-timer
552 (cancel-timer flymake-timer)
553 (setq flymake-timer nil)))
554
555;;;###autoload
556(defun flymake-find-file-hook ()
557 ;;+(when flymake-start-syntax-check-on-find-file
558 ;;+ (flymake-log 3 "starting syntax check on file open")
559 ;;+ (flymake--start-syntax-check)
560 ;;+)
561 (when (and (not (local-variable-p 'flymake-mode (current-buffer)))
562 (flymake--can-syntax-check-buffer (current-buffer)))
563 (flymake-mode)
564 (flymake-log 3 "automatically turned ON flymake mode")))
565
566(defun flymake-get-first-err-line-no (err-info-list)
567 "Return first line with error."
568 (when err-info-list
569 (flymake-er-get-line (car err-info-list))))
570
571(defun flymake-get-last-err-line-no (err-info-list)
572 "Return last line with error."
573 (when err-info-list
574 (flymake-er-get-line (nth (1- (length err-info-list)) err-info-list))))
575
576(defun flymake-get-next-err-line-no (err-info-list line-no)
577 "Return next line with error."
578 (when err-info-list
579 (let* ((count (length err-info-list))
580 (idx 0))
581 (while (and (< idx count) (>= line-no (flymake-er-get-line (nth idx err-info-list))))
582 (setq idx (1+ idx)))
583 (if (< idx count)
584 (flymake-er-get-line (nth idx err-info-list))))))
585
586(defun flymake-get-prev-err-line-no (err-info-list line-no)
587 "Return previous line with error."
588 (when err-info-list
589 (let* ((count (length err-info-list)))
590 (while (and (> count 0) (<= line-no (flymake-er-get-line (nth (1- count) err-info-list))))
591 (setq count (1- count)))
592 (if (> count 0)
593 (flymake-er-get-line (nth (1- count) err-info-list))))))
594
595(defun flymake-skip-whitespace ()
596 "Move forward until non-whitespace is reached."
597 (while (looking-at "[ \t]")
598 (forward-char)))
599
600(defun flymake-goto-line (line-no)
601 "Go to line LINE-NO, then skip whitespace."
602 (goto-char (point-min))
603 (forward-line (1- line-no))
604 (flymake-skip-whitespace))
605
606(defun flymake-goto-next-error ()
607 "Go to next error in err ring."
608 (interactive)
609 (let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos))))
610 (when (not line-no)
611 (setq line-no (flymake-get-first-err-line-no flymake-err-info))
612 (flymake-log 1 "passed end of file"))
613 (if line-no
614 (flymake-goto-line line-no)
615 (flymake-log 1 "no errors in current buffer"))))
616
617(defun flymake-goto-prev-error ()
618 "Go to previous error in err ring."
619 (interactive)
620 (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos))))
621 (when (not line-no)
622 (setq line-no (flymake-get-last-err-line-no flymake-err-info))
623 (flymake-log 1 "passed beginning of file"))
624 (if line-no
625 (flymake-goto-line line-no)
626 (flymake-log 1 "no errors in current buffer"))))
627
628(defun flymake-patch-err-text (string)
629 (if (string-match "^[\n\t :0-9]*\\(.*\\)$" string)
630 (match-string 1 string)
631 string))
632
633(provide 'flymake-ui)
634;;; flymake-ui.el ends here
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 059bce95eed..866116fbecd 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -24,18 +24,1629 @@
24 24
25;;; Commentary: 25;;; Commentary:
26;; 26;;
27;; Flymake is a minor Emacs mode performing on-the-fly syntax checks. 27;; Flymake is a minor Emacs mode performing on-the-fly syntax checks
28;; 28;; using the external syntax check tool (for C/C++ this is usually the
29;; It collects diagnostic information for multiple sources and 29;; compiler).
30;; visually annotates the relevant lines in the buffer. 30
31;; 31;;; Bugs/todo:
32;; This file is just a stub for that loads the UI and backends, which 32
33;; could also be loaded separately. 33;; - Only uses "Makefile", not "makefile" or "GNUmakefile"
34;; (from http://bugs.debian.org/337339).
34 35
35;;; Code: 36;;; Code:
36 37
37(require 'flymake-ui) 38(eval-when-compile (require 'cl-lib))
38(require 'flymake-proc) 39
40(defgroup flymake nil
41 "Universal on-the-fly syntax checker."
42 :version "23.1"
43 :link '(custom-manual "(flymake) Top")
44 :group 'tools)
45
46(defcustom flymake-error-bitmap '(exclamation-mark error)
47 "Bitmap (a symbol) used in the fringe for indicating errors.
48The value may also be a list of two elements where the second
49element specifies the face for the bitmap. For possible bitmap
50symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'.
51
52The option `flymake-fringe-indicator-position' controls how and where
53this is used."
54 :group 'flymake
55 :version "24.3"
56 :type '(choice (symbol :tag "Bitmap")
57 (list :tag "Bitmap and face"
58 (symbol :tag "Bitmap")
59 (face :tag "Face"))))
60
61(defcustom flymake-warning-bitmap 'question-mark
62 "Bitmap (a symbol) used in the fringe for indicating warnings.
63The value may also be a list of two elements where the second
64element specifies the face for the bitmap. For possible bitmap
65symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'.
66
67The option `flymake-fringe-indicator-position' controls how and where
68this is used."
69 :group 'flymake
70 :version "24.3"
71 :type '(choice (symbol :tag "Bitmap")
72 (list :tag "Bitmap and face"
73 (symbol :tag "Bitmap")
74 (face :tag "Face"))))
75
76(defcustom flymake-fringe-indicator-position 'left-fringe
77 "The position to put flymake fringe indicator.
78The value can be nil (do not use indicators), `left-fringe' or `right-fringe'.
79See `flymake-error-bitmap' and `flymake-warning-bitmap'."
80 :group 'flymake
81 :version "24.3"
82 :type '(choice (const left-fringe)
83 (const right-fringe)
84 (const :tag "No fringe indicators" nil)))
85
86(defcustom flymake-compilation-prevents-syntax-check t
87 "If non-nil, don't start syntax check if compilation is running."
88 :group 'flymake
89 :type 'boolean)
90
91(defcustom flymake-start-syntax-check-on-newline t
92 "Start syntax check if newline char was added/removed from the buffer."
93 :group 'flymake
94 :type 'boolean)
95
96(defcustom flymake-no-changes-timeout 0.5
97 "Time to wait after last change before starting compilation."
98 :group 'flymake
99 :type 'number)
100
101(defcustom flymake-gui-warnings-enabled t
102 "Enables/disables GUI warnings."
103 :group 'flymake
104 :type 'boolean)
105(make-obsolete-variable 'flymake-gui-warnings-enabled
106 "it no longer has any effect." "26.1")
107
108(defcustom flymake-start-syntax-check-on-find-file t
109 "Start syntax check on find file."
110 :group 'flymake
111 :type 'boolean)
112
113(defcustom flymake-log-level -1
114 "Logging level, only messages with level lower or equal will be logged.
115-1 = NONE, 0 = ERROR, 1 = WARNING, 2 = INFO, 3 = DEBUG"
116 :group 'flymake
117 :type 'integer)
118
119(defcustom flymake-xml-program
120 (if (executable-find "xmlstarlet") "xmlstarlet" "xml")
121 "Program to use for XML validation."
122 :type 'file
123 :group 'flymake
124 :version "24.4")
125
126(defcustom flymake-master-file-dirs '("." "./src" "./UnitTest")
127 "Dirs where to look for master files."
128 :group 'flymake
129 :type '(repeat (string)))
130
131(defcustom flymake-master-file-count-limit 32
132 "Max number of master files to check."
133 :group 'flymake
134 :type 'integer)
135
136(defcustom flymake-allowed-file-name-masks
137 '(("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'" flymake-simple-make-init)
138 ("\\.xml\\'" flymake-xml-init)
139 ("\\.html?\\'" flymake-xml-init)
140 ("\\.cs\\'" flymake-simple-make-init)
141 ("\\.p[ml]\\'" flymake-perl-init)
142 ("\\.php[345]?\\'" flymake-php-init)
143 ("\\.h\\'" flymake-master-make-header-init flymake-master-cleanup)
144 ("\\.java\\'" flymake-simple-make-java-init flymake-simple-java-cleanup)
145 ("[0-9]+\\.tex\\'" flymake-master-tex-init flymake-master-cleanup)
146 ("\\.tex\\'" flymake-simple-tex-init)
147 ("\\.idl\\'" flymake-simple-make-init)
148 ;; ("\\.cpp\\'" 1)
149 ;; ("\\.java\\'" 3)
150 ;; ("\\.h\\'" 2 ("\\.cpp\\'" "\\.c\\'")
151 ;; ("[ \t]*#[ \t]*include[ \t]*\"\\([\w0-9/\\_\.]*[/\\]*\\)\\(%s\\)\"" 1 2))
152 ;; ("\\.idl\\'" 1)
153 ;; ("\\.odl\\'" 1)
154 ;; ("[0-9]+\\.tex\\'" 2 ("\\.tex\\'")
155 ;; ("[ \t]*\\input[ \t]*{\\(.*\\)\\(%s\\)}" 1 2 ))
156 ;; ("\\.tex\\'" 1)
157 )
158 "Files syntax checking is allowed for.
159This is an alist with elements of the form:
160 REGEXP INIT [CLEANUP [NAME]]
161REGEXP is a regular expression that matches a file name.
162INIT is the init function to use, missing means disable `flymake-mode'.
163CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'.
164NAME is the file name function to use, default `flymake-get-real-file-name'."
165 :group 'flymake
166 :type '(alist :key-type (regexp :tag "File regexp")
167 :value-type
168 (list :tag "Handler functions"
169 (choice :tag "Init function"
170 (const :tag "disable" nil)
171 function)
172 (choice :tag "Cleanup function"
173 (const :tag "flymake-simple-cleanup" nil)
174 function)
175 (choice :tag "Name function"
176 (const :tag "flymake-get-real-file-name" nil)
177 function))))
178
179(defvar-local flymake-is-running nil
180 "If t, flymake syntax check process is running for the current buffer.")
181
182(defvar-local flymake-timer nil
183 "Timer for starting syntax check.")
184
185(defvar-local flymake-last-change-time nil
186 "Time of last buffer change.")
187
188(defvar-local flymake-check-start-time nil
189 "Time at which syntax check was started.")
190
191(defvar-local flymake-check-was-interrupted nil
192 "Non-nil if syntax check was killed by `flymake-compile'.")
193
194(defvar-local flymake-err-info nil
195 "Sorted list of line numbers and lists of err info in the form (file, err-text).")
196
197(defvar-local flymake-new-err-info nil
198 "Same as `flymake-err-info', effective when a syntax check is in progress.")
199
200(defun flymake-log (level text &rest args)
201 "Log a message at level LEVEL.
202If LEVEL is higher than `flymake-log-level', the message is
203ignored. Otherwise, it is printed using `message'.
204TEXT is a format control string, and the remaining arguments ARGS
205are the string substitutions (see the function `format')."
206 (if (<= level flymake-log-level)
207 (let* ((msg (apply #'format-message text args)))
208 (message "%s" msg))))
209
210(defun flymake-ins-after (list pos val)
211 "Insert VAL into LIST after position POS.
212POS counts from zero."
213 (let ((tmp (copy-sequence list)))
214 (setcdr (nthcdr pos tmp) (cons val (nthcdr (1+ pos) tmp)))
215 tmp))
216
217(defun flymake-set-at (list pos val)
218 "Set VAL at position POS in LIST.
219POS counts from zero."
220 (let ((tmp (copy-sequence list)))
221 (setcar (nthcdr pos tmp) val)
222 tmp))
223
224(defvar flymake-processes nil
225 "List of currently active flymake processes.")
226
227(defvar-local flymake-output-residual nil)
228
229(defun flymake-get-file-name-mode-and-masks (file-name)
230 "Return the corresponding entry from `flymake-allowed-file-name-masks'."
231 (unless (stringp file-name)
232 (error "Invalid file-name"))
233 (let ((fnm flymake-allowed-file-name-masks)
234 (mode-and-masks nil))
235 (while (and (not mode-and-masks) fnm)
236 (let ((item (pop fnm)))
237 (when (string-match (car item) file-name)
238 (setq mode-and-masks item)))) ; (cdr item) may be nil
239 (setq mode-and-masks (cdr mode-and-masks))
240 (flymake-log 3 "file %s, init=%s" file-name (car mode-and-masks))
241 mode-and-masks))
242
243(defun flymake-can-syntax-check-file (file-name)
244 "Determine whether we can syntax check FILE-NAME.
245Return nil if we cannot, non-nil if we can."
246 (if (flymake-get-init-function file-name) t nil))
247
248(defun flymake-get-init-function (file-name)
249 "Return init function to be used for the file."
250 (let* ((init-f (nth 0 (flymake-get-file-name-mode-and-masks file-name))))
251 ;;(flymake-log 0 "calling %s" init-f)
252 ;;(funcall init-f (current-buffer))
253 init-f))
254
255(defun flymake-get-cleanup-function (file-name)
256 "Return cleanup function to be used for the file."
257 (or (nth 1 (flymake-get-file-name-mode-and-masks file-name))
258 'flymake-simple-cleanup))
259
260(defun flymake-get-real-file-name-function (file-name)
261 (or (nth 2 (flymake-get-file-name-mode-and-masks file-name))
262 'flymake-get-real-file-name))
263
264(defvar flymake-find-buildfile-cache (make-hash-table :test #'equal))
265
266(defun flymake-get-buildfile-from-cache (dir-name)
267 "Look up DIR-NAME in cache and return its associated value.
268If DIR-NAME is not found, return nil."
269 (gethash dir-name flymake-find-buildfile-cache))
270
271(defun flymake-add-buildfile-to-cache (dir-name buildfile)
272 "Associate DIR-NAME with BUILDFILE in the buildfile cache."
273 (puthash dir-name buildfile flymake-find-buildfile-cache))
274
275(defun flymake-clear-buildfile-cache ()
276 "Clear the buildfile cache."
277 (clrhash flymake-find-buildfile-cache))
278
279(defun flymake-find-buildfile (buildfile-name source-dir-name)
280 "Find buildfile starting from current directory.
281Buildfile includes Makefile, build.xml etc.
282Return its file name if found, or nil if not found."
283 (or (flymake-get-buildfile-from-cache source-dir-name)
284 (let* ((file (locate-dominating-file source-dir-name buildfile-name)))
285 (if file
286 (progn
287 (flymake-log 3 "found buildfile at %s" file)
288 (flymake-add-buildfile-to-cache source-dir-name file)
289 file)
290 (progn
291 (flymake-log 3 "buildfile for %s not found" source-dir-name)
292 nil)))))
293
294(defun flymake-fix-file-name (name)
295 "Replace all occurrences of `\\' with `/'."
296 (when name
297 (setq name (expand-file-name name))
298 (setq name (abbreviate-file-name name))
299 (setq name (directory-file-name name))
300 name))
301
302(defun flymake-same-files (file-name-one file-name-two)
303 "Check if FILE-NAME-ONE and FILE-NAME-TWO point to same file.
304Return t if so, nil if not."
305 (equal (flymake-fix-file-name file-name-one)
306 (flymake-fix-file-name file-name-two)))
307
308;; This is bound dynamically to pass a parameter to a sort predicate below
309(defvar flymake-included-file-name)
310
311(defun flymake-find-possible-master-files (file-name master-file-dirs masks)
312 "Find (by name and location) all possible master files.
313
314Name is specified by FILE-NAME and location is specified by
315MASTER-FILE-DIRS. Master files include .cpp and .c for .h.
316Files are searched for starting from the .h directory and max
317max-level parent dirs. File contents are not checked."
318 (let* ((dirs master-file-dirs)
319 (files nil)
320 (done nil))
321
322 (while (and (not done) dirs)
323 (let* ((dir (expand-file-name (car dirs) (file-name-directory file-name)))
324 (masks masks))
325 (while (and (file-exists-p dir) (not done) masks)
326 (let* ((mask (car masks))
327 (dir-files (directory-files dir t mask)))
328
329 (flymake-log 3 "dir %s, %d file(s) for mask %s"
330 dir (length dir-files) mask)
331 (while (and (not done) dir-files)
332 (when (not (file-directory-p (car dir-files)))
333 (setq files (cons (car dir-files) files))
334 (when (>= (length files) flymake-master-file-count-limit)
335 (flymake-log 3 "master file count limit (%d) reached" flymake-master-file-count-limit)
336 (setq done t)))
337 (setq dir-files (cdr dir-files))))
338 (setq masks (cdr masks))))
339 (setq dirs (cdr dirs)))
340 (when files
341 (let ((flymake-included-file-name (file-name-nondirectory file-name)))
342 (setq files (sort files 'flymake-master-file-compare))))
343 (flymake-log 3 "found %d possible master file(s)" (length files))
344 files))
345
346(defun flymake-master-file-compare (file-one file-two)
347 "Compare two files specified by FILE-ONE and FILE-TWO.
348This function is used in sort to move most possible file names
349to the beginning of the list (File.h -> File.cpp moved to top)."
350 (and (equal (file-name-sans-extension flymake-included-file-name)
351 (file-name-base file-one))
352 (not (equal file-one file-two))))
353
354(defvar flymake-check-file-limit 8192
355 "Maximum number of chars to look at when checking possible master file.
356Nil means search the entire file.")
357
358(defun flymake-check-patch-master-file-buffer
359 (master-file-temp-buffer
360 master-file-name patched-master-file-name
361 source-file-name patched-source-file-name
362 include-dirs regexp)
363 "Check if MASTER-FILE-NAME is a master file for SOURCE-FILE-NAME.
364If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME
365instead of SOURCE-FILE-NAME.
366
367For example, foo.cpp is a master file if it includes foo.h.
368
369When a buffer for MASTER-FILE-NAME exists, use it as a source
370instead of reading master file from disk."
371 (let* ((source-file-nondir (file-name-nondirectory source-file-name))
372 (source-file-extension (file-name-extension source-file-nondir))
373 (source-file-nonext (file-name-sans-extension source-file-nondir))
374 (found nil)
375 (inc-name nil)
376 (search-limit flymake-check-file-limit))
377 (setq regexp
378 (format regexp ; "[ \t]*#[ \t]*include[ \t]*\"\\(.*%s\\)\""
379 ;; Hack for tex files, where \include often excludes .tex.
380 ;; Maybe this is safe generally.
381 (if (and (> (length source-file-extension) 1)
382 (string-equal source-file-extension "tex"))
383 (format "%s\\(?:\\.%s\\)?"
384 (regexp-quote source-file-nonext)
385 (regexp-quote source-file-extension))
386 (regexp-quote source-file-nondir))))
387 (unwind-protect
388 (with-current-buffer master-file-temp-buffer
389 (if (or (not search-limit)
390 (> search-limit (point-max)))
391 (setq search-limit (point-max)))
392 (flymake-log 3 "checking %s against regexp %s"
393 master-file-name regexp)
394 (goto-char (point-min))
395 (while (and (< (point) search-limit)
396 (re-search-forward regexp search-limit t))
397 (let ((match-beg (match-beginning 1))
398 (match-end (match-end 1)))
399
400 (flymake-log 3 "found possible match for %s" source-file-nondir)
401 (setq inc-name (match-string 1))
402 (and (> (length source-file-extension) 1)
403 (string-equal source-file-extension "tex")
404 (not (string-match (format "\\.%s\\'" source-file-extension)
405 inc-name))
406 (setq inc-name (concat inc-name "." source-file-extension)))
407 (when (eq t (compare-strings
408 source-file-nondir nil nil
409 inc-name (- (length inc-name)
410 (length source-file-nondir)) nil))
411 (flymake-log 3 "inc-name=%s" inc-name)
412 (when (flymake-check-include source-file-name inc-name
413 include-dirs)
414 (setq found t)
415 ;; replace-match is not used here as it fails in
416 ;; XEmacs with 'last match not a buffer' error as
417 ;; check-includes calls replace-in-string
418 (flymake-replace-region
419 match-beg match-end
420 (file-name-nondirectory patched-source-file-name))))
421 (forward-line 1)))
422 (when found
423 (flymake-save-buffer-in-file patched-master-file-name)))
424 ;;+(flymake-log 3 "killing buffer %s"
425 ;; (buffer-name master-file-temp-buffer))
426 (kill-buffer master-file-temp-buffer))
427 ;;+(flymake-log 3 "check-patch master file %s: %s" master-file-name found)
428 (when found
429 (flymake-log 2 "found master file %s" master-file-name))
430 found))
431
432;;; XXX: remove
433(defun flymake-replace-region (beg end rep)
434 "Replace text in BUFFER in region (BEG END) with REP."
435 (save-excursion
436 (goto-char end)
437 ;; Insert before deleting, so as to better preserve markers's positions.
438 (insert rep)
439 (delete-region beg end)))
440
441(defun flymake-read-file-to-temp-buffer (file-name)
442 "Insert contents of FILE-NAME into newly created temp buffer."
443 (let* ((temp-buffer (get-buffer-create (generate-new-buffer-name (concat "flymake:" (file-name-nondirectory file-name))))))
444 (with-current-buffer temp-buffer
445 (insert-file-contents file-name))
446 temp-buffer))
447
448(defun flymake-copy-buffer-to-temp-buffer (buffer)
449 "Copy contents of BUFFER into newly created temp buffer."
450 (with-current-buffer
451 (get-buffer-create (generate-new-buffer-name
452 (concat "flymake:" (buffer-name buffer))))
453 (insert-buffer-substring buffer)
454 (current-buffer)))
455
456(defun flymake-check-include (source-file-name inc-name include-dirs)
457 "Check if SOURCE-FILE-NAME can be found in include path.
458Return t if it can be found via include path using INC-NAME."
459 (if (file-name-absolute-p inc-name)
460 (flymake-same-files source-file-name inc-name)
461 (while (and include-dirs
462 (not (flymake-same-files
463 source-file-name
464 (concat (file-name-directory source-file-name)
465 "/" (car include-dirs)
466 "/" inc-name))))
467 (setq include-dirs (cdr include-dirs)))
468 include-dirs))
469
470(defun flymake-find-buffer-for-file (file-name)
471 "Check if there exists a buffer visiting FILE-NAME.
472Return t if so, nil if not."
473 (let ((buffer-name (get-file-buffer file-name)))
474 (if buffer-name
475 (get-buffer buffer-name))))
476
477(defun flymake-create-master-file (source-file-name patched-source-file-name get-incl-dirs-f create-temp-f masks include-regexp)
478 "Save SOURCE-FILE-NAME with a different name.
479Find master file, patch and save it."
480 (let* ((possible-master-files (flymake-find-possible-master-files source-file-name flymake-master-file-dirs masks))
481 (master-file-count (length possible-master-files))
482 (idx 0)
483 (temp-buffer nil)
484 (master-file-name nil)
485 (patched-master-file-name nil)
486 (found nil))
487
488 (while (and (not found) (< idx master-file-count))
489 (setq master-file-name (nth idx possible-master-files))
490 (setq patched-master-file-name (funcall create-temp-f master-file-name "flymake_master"))
491 (if (flymake-find-buffer-for-file master-file-name)
492 (setq temp-buffer (flymake-copy-buffer-to-temp-buffer (flymake-find-buffer-for-file master-file-name)))
493 (setq temp-buffer (flymake-read-file-to-temp-buffer master-file-name)))
494 (setq found
495 (flymake-check-patch-master-file-buffer
496 temp-buffer
497 master-file-name
498 patched-master-file-name
499 source-file-name
500 patched-source-file-name
501 (funcall get-incl-dirs-f (file-name-directory master-file-name))
502 include-regexp))
503 (setq idx (1+ idx)))
504 (if found
505 (list master-file-name patched-master-file-name)
506 (progn
507 (flymake-log 3 "none of %d master file(s) checked includes %s" master-file-count
508 (file-name-nondirectory source-file-name))
509 nil))))
510
511(defun flymake-save-buffer-in-file (file-name)
512 "Save the entire buffer contents into file FILE-NAME.
513Create parent directories as needed."
514 (make-directory (file-name-directory file-name) 1)
515 (write-region nil nil file-name nil 566)
516 (flymake-log 3 "saved buffer %s in file %s" (buffer-name) file-name))
517
518(defun flymake-process-filter (process output)
519 "Parse OUTPUT and highlight error lines.
520It's flymake process filter."
521 (let ((source-buffer (process-buffer process)))
522
523 (flymake-log 3 "received %d byte(s) of output from process %d"
524 (length output) (process-id process))
525 (when (buffer-live-p source-buffer)
526 (with-current-buffer source-buffer
527 (flymake-parse-output-and-residual output)))))
528
529(defun flymake-process-sentinel (process _event)
530 "Sentinel for syntax check buffers."
531 (when (memq (process-status process) '(signal exit))
532 (let* ((exit-status (process-exit-status process))
533 (command (process-command process))
534 (source-buffer (process-buffer process))
535 (cleanup-f (flymake-get-cleanup-function (buffer-file-name source-buffer))))
536
537 (flymake-log 2 "process %d exited with code %d"
538 (process-id process) exit-status)
539 (condition-case err
540 (progn
541 (flymake-log 3 "cleaning up using %s" cleanup-f)
542 (when (buffer-live-p source-buffer)
543 (with-current-buffer source-buffer
544 (funcall cleanup-f)))
545
546 (delete-process process)
547 (setq flymake-processes (delq process flymake-processes))
548
549 (when (buffer-live-p source-buffer)
550 (with-current-buffer source-buffer
551
552 (flymake-parse-residual)
553 (flymake-post-syntax-check exit-status command)
554 (setq flymake-is-running nil))))
555 (error
556 (let ((err-str (format "Error in process sentinel for buffer %s: %s"
557 source-buffer (error-message-string err))))
558 (flymake-log 0 err-str)
559 (with-current-buffer source-buffer
560 (setq flymake-is-running nil))))))))
561
562(defun flymake-post-syntax-check (exit-status command)
563 (save-restriction
564 (widen)
565 (setq flymake-err-info flymake-new-err-info)
566 (setq flymake-new-err-info nil)
567 (setq flymake-err-info
568 (flymake-fix-line-numbers
569 flymake-err-info 1 (count-lines (point-min) (point-max))))
570 (flymake-delete-own-overlays)
571 (flymake-highlight-err-lines flymake-err-info)
572 (let (err-count warn-count)
573 (setq err-count (flymake-get-err-count flymake-err-info "e"))
574 (setq warn-count (flymake-get-err-count flymake-err-info "w"))
575 (flymake-log 2 "%s: %d error(s), %d warning(s) in %.2f second(s)"
576 (buffer-name) err-count warn-count
577 (- (float-time) flymake-check-start-time))
578 (setq flymake-check-start-time nil)
579
580 (if (and (equal 0 err-count) (equal 0 warn-count))
581 (if (equal 0 exit-status)
582 (flymake-report-status "" "") ; PASSED
583 (if (not flymake-check-was-interrupted)
584 (flymake-report-fatal-status "CFGERR"
585 (format "Configuration error has occurred while running %s" command))
586 (flymake-report-status nil ""))) ; "STOPPED"
587 (flymake-report-status (format "%d/%d" err-count warn-count) "")))))
588
589(defun flymake-parse-output-and-residual (output)
590 "Split OUTPUT into lines, merge in residual if necessary."
591 (let* ((buffer-residual flymake-output-residual)
592 (total-output (if buffer-residual (concat buffer-residual output) output))
593 (lines-and-residual (flymake-split-output total-output))
594 (lines (nth 0 lines-and-residual))
595 (new-residual (nth 1 lines-and-residual)))
596 (setq flymake-output-residual new-residual)
597 (setq flymake-new-err-info
598 (flymake-parse-err-lines
599 flymake-new-err-info lines))))
600
601(defun flymake-parse-residual ()
602 "Parse residual if it's non empty."
603 (when flymake-output-residual
604 (setq flymake-new-err-info
605 (flymake-parse-err-lines
606 flymake-new-err-info
607 (list flymake-output-residual)))
608 (setq flymake-output-residual nil)))
609
610(defun flymake-er-make-er (line-no line-err-info-list)
611 (list line-no line-err-info-list))
612
613(defun flymake-er-get-line (err-info)
614 (nth 0 err-info))
615
616(defun flymake-er-get-line-err-info-list (err-info)
617 (nth 1 err-info))
618
619(cl-defstruct (flymake-ler
620 (:constructor nil)
621 (:constructor flymake-ler-make-ler (file line type text &optional full-file)))
622 file line type text full-file)
623
624(defun flymake-ler-set-file (line-err-info file)
625 (flymake-ler-make-ler file
626 (flymake-ler-line line-err-info)
627 (flymake-ler-type line-err-info)
628 (flymake-ler-text line-err-info)
629 (flymake-ler-full-file line-err-info)))
630
631(defun flymake-ler-set-full-file (line-err-info full-file)
632 (flymake-ler-make-ler (flymake-ler-file line-err-info)
633 (flymake-ler-line line-err-info)
634 (flymake-ler-type line-err-info)
635 (flymake-ler-text line-err-info)
636 full-file))
637
638(defun flymake-ler-set-line (line-err-info line)
639 (flymake-ler-make-ler (flymake-ler-file line-err-info)
640 line
641 (flymake-ler-type line-err-info)
642 (flymake-ler-text line-err-info)
643 (flymake-ler-full-file line-err-info)))
644
645(defun flymake-get-line-err-count (line-err-info-list type)
646 "Return number of errors of specified TYPE.
647Value of TYPE is either \"e\" or \"w\"."
648 (let* ((idx 0)
649 (count (length line-err-info-list))
650 (err-count 0))
651
652 (while (< idx count)
653 (when (equal type (flymake-ler-type (nth idx line-err-info-list)))
654 (setq err-count (1+ err-count)))
655 (setq idx (1+ idx)))
656 err-count))
657
658(defun flymake-get-err-count (err-info-list type)
659 "Return number of errors of specified TYPE for ERR-INFO-LIST."
660 (let* ((idx 0)
661 (count (length err-info-list))
662 (err-count 0))
663 (while (< idx count)
664 (setq err-count (+ err-count (flymake-get-line-err-count (nth 1 (nth idx err-info-list)) type)))
665 (setq idx (1+ idx)))
666 err-count))
667
668(defun flymake-fix-line-numbers (err-info-list min-line max-line)
669 "Replace line numbers with fixed value.
670If line-numbers is less than MIN-LINE, set line numbers to MIN-LINE.
671If line numbers is greater than MAX-LINE, set line numbers to MAX-LINE.
672The reason for this fix is because some compilers might report
673line number outside the file being compiled."
674 (let* ((count (length err-info-list))
675 (err-info nil)
676 (line 0))
677 (while (> count 0)
678 (setq err-info (nth (1- count) err-info-list))
679 (setq line (flymake-er-get-line err-info))
680 (when (or (< line min-line) (> line max-line))
681 (setq line (if (< line min-line) min-line max-line))
682 (setq err-info-list (flymake-set-at err-info-list (1- count)
683 (flymake-er-make-er line
684 (flymake-er-get-line-err-info-list err-info)))))
685 (setq count (1- count))))
686 err-info-list)
687
688(defun flymake-highlight-err-lines (err-info-list)
689 "Highlight error lines in BUFFER using info from ERR-INFO-LIST."
690 (save-excursion
691 (dolist (err err-info-list)
692 (flymake-highlight-line (car err) (nth 1 err)))))
693
694(defun flymake-overlay-p (ov)
695 "Determine whether overlay OV was created by flymake."
696 (and (overlayp ov) (overlay-get ov 'flymake-overlay)))
697
698(defun flymake-make-overlay (beg end tooltip-text face bitmap)
699 "Allocate a flymake overlay in range BEG and END."
700 (when (not (flymake-region-has-flymake-overlays beg end))
701 (let ((ov (make-overlay beg end nil t))
702 (fringe (and flymake-fringe-indicator-position
703 (propertize "!" 'display
704 (cons flymake-fringe-indicator-position
705 (if (listp bitmap)
706 bitmap
707 (list bitmap)))))))
708 (overlay-put ov 'face face)
709 (overlay-put ov 'help-echo tooltip-text)
710 (overlay-put ov 'flymake-overlay t)
711 (overlay-put ov 'priority 100)
712 (overlay-put ov 'evaporate t)
713 (overlay-put ov 'before-string fringe)
714 ;;+(flymake-log 3 "created overlay %s" ov)
715 ov)
716 (flymake-log 3 "created an overlay at (%d-%d)" beg end)))
717
718(defun flymake-delete-own-overlays ()
719 "Delete all flymake overlays in BUFFER."
720 (dolist (ol (overlays-in (point-min) (point-max)))
721 (when (flymake-overlay-p ol)
722 (delete-overlay ol)
723 ;;+(flymake-log 3 "deleted overlay %s" ol)
724 )))
725
726(defun flymake-region-has-flymake-overlays (beg end)
727 "Check if region specified by BEG and END has overlay.
728Return t if it has at least one flymake overlay, nil if no overlay."
729 (let ((ov (overlays-in beg end))
730 (has-flymake-overlays nil))
731 (while (consp ov)
732 (when (flymake-overlay-p (car ov))
733 (setq has-flymake-overlays t))
734 (setq ov (cdr ov)))
735 has-flymake-overlays))
736
737(defface flymake-errline
738 '((((supports :underline (:style wave)))
739 :underline (:style wave :color "Red1"))
740 (t
741 :inherit error))
742 "Face used for marking error lines."
743 :version "24.4"
744 :group 'flymake)
745
746(defface flymake-warnline
747 '((((supports :underline (:style wave)))
748 :underline (:style wave :color "DarkOrange"))
749 (t
750 :inherit warning))
751 "Face used for marking warning lines."
752 :version "24.4"
753 :group 'flymake)
754
755(defun flymake-highlight-line (line-no line-err-info-list)
756 "Highlight line LINE-NO in current buffer.
757Perhaps use text from LINE-ERR-INFO-LIST to enhance highlighting."
758 (goto-char (point-min))
759 (forward-line (1- line-no))
760 (pcase-let* ((beg (progn (back-to-indentation) (point)))
761 (end (progn
762 (end-of-line)
763 (skip-chars-backward " \t\f\t\n" beg)
764 (if (eq (point) beg)
765 (line-beginning-position 2)
766 (point))))
767 (tooltip-text (mapconcat #'flymake-ler-text line-err-info-list "\n"))
768 (`(,face ,bitmap)
769 (if (> (flymake-get-line-err-count line-err-info-list "e") 0)
770 (list 'flymake-errline flymake-error-bitmap)
771 (list 'flymake-warnline flymake-warning-bitmap))))
772 (flymake-make-overlay beg end tooltip-text face bitmap)))
773
774(defun flymake-parse-err-lines (err-info-list lines)
775 "Parse err LINES, store info in ERR-INFO-LIST."
776 (let* ((count (length lines))
777 (idx 0)
778 (line-err-info nil)
779 (real-file-name nil)
780 (source-file-name buffer-file-name)
781 (get-real-file-name-f (flymake-get-real-file-name-function source-file-name)))
782
783 (while (< idx count)
784 (setq line-err-info (flymake-parse-line (nth idx lines)))
785 (when line-err-info
786 (setq real-file-name (funcall get-real-file-name-f
787 (flymake-ler-file line-err-info)))
788 (setq line-err-info (flymake-ler-set-full-file line-err-info real-file-name))
789
790 (when (flymake-same-files real-file-name source-file-name)
791 (setq line-err-info (flymake-ler-set-file line-err-info nil))
792 (setq err-info-list (flymake-add-err-info err-info-list line-err-info))))
793 (flymake-log 3 "parsed `%s', %s line-err-info" (nth idx lines) (if line-err-info "got" "no"))
794 (setq idx (1+ idx)))
795 err-info-list))
796
797(defun flymake-split-output (output)
798 "Split OUTPUT into lines.
799Return last one as residual if it does not end with newline char.
800Returns ((LINES) RESIDUAL)."
801 (when (and output (> (length output) 0))
802 (let* ((lines (split-string output "[\n\r]+" t))
803 (complete (equal "\n" (char-to-string (aref output (1- (length output))))))
804 (residual nil))
805 (when (not complete)
806 (setq residual (car (last lines)))
807 (setq lines (butlast lines)))
808 (list lines residual))))
809
810(defun flymake-reformat-err-line-patterns-from-compile-el (original-list)
811 "Grab error line patterns from ORIGINAL-LIST in compile.el format.
812Convert it to flymake internal format."
813 (let* ((converted-list '()))
814 (dolist (item original-list)
815 (setq item (cdr item))
816 (let ((regexp (nth 0 item))
817 (file (nth 1 item))
818 (line (nth 2 item))
819 (col (nth 3 item)))
820 (if (consp file) (setq file (car file)))
821 (if (consp line) (setq line (car line)))
822 (if (consp col) (setq col (car col)))
823
824 (when (not (functionp line))
825 (setq converted-list (cons (list regexp file line col) converted-list)))))
826 converted-list))
827
828(require 'compile)
829
830(defvar flymake-err-line-patterns ; regexp file-idx line-idx col-idx (optional) text-idx(optional), match-end to end of string is error text
831 (append
832 '(
833 ;; MS Visual C++ 6.0
834 ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\)) : \\(\\(error\\|warning\\|fatal error\\) \\(C[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
835 1 3 nil 4)
836 ;; jikes
837 ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\):[0-9]+:[0-9]+:[0-9]+: \\(\\(Error\\|Warning\\|Caution\\|Semantic Error\\):[ \t\n]*\\(.+\\)\\)"
838 1 3 nil 4)
839 ;; MS midl
840 ("midl[ ]*:[ ]*\\(command line error .*\\)"
841 nil nil nil 1)
842 ;; MS C#
843 ("\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\)(\\([0-9]+\\),[0-9]+): \\(\\(error\\|warning\\|fatal error\\) \\(CS[0-9]+\\):[ \t\n]*\\(.+\\)\\)"
844 1 3 nil 4)
845 ;; perl
846 ("\\(.*\\) at \\([^ \n]+\\) line \\([0-9]+\\)[,.\n]" 2 3 nil 1)
847 ;; PHP
848 ("\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil 1)
849 ;; LaTeX warnings (fileless) ("\\(LaTeX \\(Warning\\|Error\\): .*\\) on input line \\([0-9]+\\)" 20 3 nil 1)
850 ;; ant/javac. Note this also matches gcc warnings!
851 (" *\\(\\[javac\\] *\\)?\\(\\([a-zA-Z]:\\)?[^:(\t\n]+\\):\\([0-9]+\\)\\(?::[0-9]+\\)?:[ \t\n]*\\(.+\\)"
852 2 4 nil 5))
853 ;; compilation-error-regexp-alist)
854 (flymake-reformat-err-line-patterns-from-compile-el compilation-error-regexp-alist-alist))
855 "Patterns for matching error/warning lines. Each pattern has the form
856\(REGEXP FILE-IDX LINE-IDX COL-IDX ERR-TEXT-IDX).
857Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns
858from compile.el")
859
860(define-obsolete-variable-alias 'flymake-warning-re 'flymake-warning-predicate "24.4")
861(defvar flymake-warning-predicate "^[wW]arning"
862 "Predicate matching against error text to detect a warning.
863Takes a single argument, the error's text and should return non-nil
864if it's a warning.
865Instead of a function, it can also be a regular expression.")
866
867(defun flymake-parse-line (line)
868 "Parse LINE to see if it is an error or warning.
869Return its components if so, nil otherwise."
870 (let ((raw-file-name nil)
871 (line-no 0)
872 (err-type "e")
873 (err-text nil)
874 (patterns flymake-err-line-patterns)
875 (matched nil))
876 (while (and patterns (not matched))
877 (when (string-match (car (car patterns)) line)
878 (let* ((file-idx (nth 1 (car patterns)))
879 (line-idx (nth 2 (car patterns))))
880
881 (setq raw-file-name (if file-idx (match-string file-idx line) nil))
882 (setq line-no (if line-idx (string-to-number
883 (match-string line-idx line)) 0))
884 (setq err-text (if (> (length (car patterns)) 4)
885 (match-string (nth 4 (car patterns)) line)
886 (flymake-patch-err-text
887 (substring line (match-end 0)))))
888 (if (null err-text)
889 (setq err-text "<no error text>")
890 (when (cond ((stringp flymake-warning-predicate)
891 (string-match flymake-warning-predicate err-text))
892 ((functionp flymake-warning-predicate)
893 (funcall flymake-warning-predicate err-text)))
894 (setq err-type "w")))
895 (flymake-log
896 3 "parse line: file-idx=%s line-idx=%s file=%s line=%s text=%s"
897 file-idx line-idx raw-file-name line-no err-text)
898 (setq matched t)))
899 (setq patterns (cdr patterns)))
900 (if matched
901 (flymake-ler-make-ler raw-file-name line-no err-type err-text)
902 ())))
903
904(defun flymake-find-err-info (err-info-list line-no)
905 "Find (line-err-info-list pos) for specified LINE-NO."
906 (if err-info-list
907 (let* ((line-err-info-list nil)
908 (pos 0)
909 (count (length err-info-list)))
910
911 (while (and (< pos count) (< (car (nth pos err-info-list)) line-no))
912 (setq pos (1+ pos)))
913 (when (and (< pos count) (equal (car (nth pos err-info-list)) line-no))
914 (setq line-err-info-list (flymake-er-get-line-err-info-list (nth pos err-info-list))))
915 (list line-err-info-list pos))
916 '(nil 0)))
917
918(defun flymake-line-err-info-is-less-or-equal (line-one line-two)
919 (or (string< (flymake-ler-type line-one) (flymake-ler-type line-two))
920 (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two))
921 (not (flymake-ler-file line-one)) (flymake-ler-file line-two))
922 (and (string= (flymake-ler-type line-one) (flymake-ler-type line-two))
923 (or (and (flymake-ler-file line-one) (flymake-ler-file line-two))
924 (and (not (flymake-ler-file line-one)) (not (flymake-ler-file line-two)))))))
925
926(defun flymake-add-line-err-info (line-err-info-list line-err-info)
927 "Update LINE-ERR-INFO-LIST with the error LINE-ERR-INFO.
928For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'.
929The new element is inserted in the proper position, according to
930the predicate `flymake-line-err-info-is-less-or-equal'.
931The updated value of LINE-ERR-INFO-LIST is returned."
932 (if (not line-err-info-list)
933 (list line-err-info)
934 (let* ((count (length line-err-info-list))
935 (idx 0))
936 (while (and (< idx count) (flymake-line-err-info-is-less-or-equal (nth idx line-err-info-list) line-err-info))
937 (setq idx (1+ idx)))
938 (cond ((equal 0 idx) (setq line-err-info-list (cons line-err-info line-err-info-list)))
939 (t (setq line-err-info-list (flymake-ins-after line-err-info-list (1- idx) line-err-info))))
940 line-err-info-list)))
941
942(defun flymake-add-err-info (err-info-list line-err-info)
943 "Update ERR-INFO-LIST with the error LINE-ERR-INFO, preserving sort order.
944Returns the updated value of ERR-INFO-LIST.
945For the format of ERR-INFO-LIST, see `flymake-err-info'.
946For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'."
947 (let* ((line-no (if (flymake-ler-file line-err-info) 1 (flymake-ler-line line-err-info)))
948 (info-and-pos (flymake-find-err-info err-info-list line-no))
949 (exists (car info-and-pos))
950 (pos (nth 1 info-and-pos))
951 (line-err-info-list nil)
952 (err-info nil))
953
954 (if exists
955 (setq line-err-info-list (flymake-er-get-line-err-info-list (car (nthcdr pos err-info-list)))))
956 (setq line-err-info-list (flymake-add-line-err-info line-err-info-list line-err-info))
957
958 (setq err-info (flymake-er-make-er line-no line-err-info-list))
959 (cond (exists (setq err-info-list (flymake-set-at err-info-list pos err-info)))
960 ((equal 0 pos) (setq err-info-list (cons err-info err-info-list)))
961 (t (setq err-info-list (flymake-ins-after err-info-list (1- pos) err-info))))
962 err-info-list))
963
964(defun flymake-get-project-include-dirs-imp (basedir)
965 "Include dirs for the project current file belongs to."
966 (if (flymake-get-project-include-dirs-from-cache basedir)
967 (progn
968 (flymake-get-project-include-dirs-from-cache basedir))
969 ;;else
970 (let* ((command-line (concat "make -C "
971 (shell-quote-argument basedir)
972 " DUMPVARS=INCLUDE_DIRS dumpvars"))
973 (output (shell-command-to-string command-line))
974 (lines (split-string output "\n" t))
975 (count (length lines))
976 (idx 0)
977 (inc-dirs nil))
978 (while (and (< idx count) (not (string-match "^INCLUDE_DIRS=.*" (nth idx lines))))
979 (setq idx (1+ idx)))
980 (when (< idx count)
981 (let* ((inc-lines (split-string (nth idx lines) " *-I" t))
982 (inc-count (length inc-lines)))
983 (while (> inc-count 0)
984 (when (not (string-match "^INCLUDE_DIRS=.*" (nth (1- inc-count) inc-lines)))
985 (push (replace-regexp-in-string "\"" "" (nth (1- inc-count) inc-lines)) inc-dirs))
986 (setq inc-count (1- inc-count)))))
987 (flymake-add-project-include-dirs-to-cache basedir inc-dirs)
988 inc-dirs)))
989
990(defvar flymake-get-project-include-dirs-function #'flymake-get-project-include-dirs-imp
991 "Function used to get project include dirs, one parameter: basedir name.")
992
993(defun flymake-get-project-include-dirs (basedir)
994 (funcall flymake-get-project-include-dirs-function basedir))
995
996(defun flymake-get-system-include-dirs ()
997 "System include dirs - from the `INCLUDE' env setting."
998 (let* ((includes (getenv "INCLUDE")))
999 (if includes (split-string includes path-separator t) nil)))
1000
1001(defvar flymake-project-include-dirs-cache (make-hash-table :test #'equal))
1002
1003(defun flymake-get-project-include-dirs-from-cache (base-dir)
1004 (gethash base-dir flymake-project-include-dirs-cache))
1005
1006(defun flymake-add-project-include-dirs-to-cache (base-dir include-dirs)
1007 (puthash base-dir include-dirs flymake-project-include-dirs-cache))
1008
1009(defun flymake-clear-project-include-dirs-cache ()
1010 (clrhash flymake-project-include-dirs-cache))
1011
1012(defun flymake-get-include-dirs (base-dir)
1013 "Get dirs to use when resolving local file names."
1014 (let* ((include-dirs (append '(".") (flymake-get-project-include-dirs base-dir) (flymake-get-system-include-dirs))))
1015 include-dirs))
1016
1017;; (defun flymake-restore-formatting ()
1018;; "Remove any formatting made by flymake."
1019;; )
1020
1021;; (defun flymake-get-program-dir (buffer)
1022;; "Get dir to start program in."
1023;; (unless (bufferp buffer)
1024;; (error "Invalid buffer"))
1025;; (with-current-buffer buffer
1026;; default-directory))
1027
1028(defun flymake-safe-delete-file (file-name)
1029 (when (and file-name (file-exists-p file-name))
1030 (delete-file file-name)
1031 (flymake-log 1 "deleted file %s" file-name)))
1032
1033(defun flymake-safe-delete-directory (dir-name)
1034 (condition-case nil
1035 (progn
1036 (delete-directory dir-name)
1037 (flymake-log 1 "deleted dir %s" dir-name))
1038 (error
1039 (flymake-log 1 "Failed to delete dir %s, error ignored" dir-name))))
1040
1041(defun flymake-start-syntax-check ()
1042 "Start syntax checking for current buffer."
1043 (interactive)
1044 (flymake-log 3 "flymake is running: %s" flymake-is-running)
1045 (when (and (not flymake-is-running)
1046 (flymake-can-syntax-check-file buffer-file-name))
1047 (when (or (not flymake-compilation-prevents-syntax-check)
1048 (not (flymake-compilation-is-running))) ;+ (flymake-rep-ort-status buffer "COMP")
1049 (flymake-clear-buildfile-cache)
1050 (flymake-clear-project-include-dirs-cache)
1051
1052 (setq flymake-check-was-interrupted nil)
1053
1054 (let* ((source-file-name buffer-file-name)
1055 (init-f (flymake-get-init-function source-file-name))
1056 (cleanup-f (flymake-get-cleanup-function source-file-name))
1057 (cmd-and-args (funcall init-f))
1058 (cmd (nth 0 cmd-and-args))
1059 (args (nth 1 cmd-and-args))
1060 (dir (nth 2 cmd-and-args)))
1061 (if (not cmd-and-args)
1062 (progn
1063 (flymake-log 0 "init function %s for %s failed, cleaning up" init-f source-file-name)
1064 (funcall cleanup-f))
1065 (progn
1066 (setq flymake-last-change-time nil)
1067 (flymake-start-syntax-check-process cmd args dir)))))))
1068
1069(defun flymake-start-syntax-check-process (cmd args dir)
1070 "Start syntax check process."
1071 (condition-case err
1072 (let* ((process
1073 (let ((default-directory (or dir default-directory)))
1074 (when dir
1075 (flymake-log 3 "starting process on dir %s" dir))
1076 (apply 'start-file-process
1077 "flymake-proc" (current-buffer) cmd args))))
1078 (set-process-sentinel process 'flymake-process-sentinel)
1079 (set-process-filter process 'flymake-process-filter)
1080 (set-process-query-on-exit-flag process nil)
1081 (push process flymake-processes)
1082
1083 (setq flymake-is-running t)
1084 (setq flymake-last-change-time nil)
1085 (setq flymake-check-start-time (float-time))
1086
1087 (flymake-report-status nil "*")
1088 (flymake-log 2 "started process %d, command=%s, dir=%s"
1089 (process-id process) (process-command process)
1090 default-directory)
1091 process)
1092 (error
1093 (let* ((err-str
1094 (format-message
1095 "Failed to launch syntax check process `%s' with args %s: %s"
1096 cmd args (error-message-string err)))
1097 (source-file-name buffer-file-name)
1098 (cleanup-f (flymake-get-cleanup-function source-file-name)))
1099 (flymake-log 0 err-str)
1100 (funcall cleanup-f)
1101 (flymake-report-fatal-status "PROCERR" err-str)))))
1102
1103(defun flymake-kill-process (proc)
1104 "Kill process PROC."
1105 (kill-process proc)
1106 (let* ((buf (process-buffer proc)))
1107 (when (buffer-live-p buf)
1108 (with-current-buffer buf
1109 (setq flymake-check-was-interrupted t))))
1110 (flymake-log 1 "killed process %d" (process-id proc)))
1111
1112(defun flymake-stop-all-syntax-checks ()
1113 "Kill all syntax check processes."
1114 (interactive)
1115 (while flymake-processes
1116 (flymake-kill-process (pop flymake-processes))))
1117
1118(defun flymake-compilation-is-running ()
1119 (and (boundp 'compilation-in-progress)
1120 compilation-in-progress))
1121
1122(defun flymake-compile ()
1123 "Kill all flymake syntax checks, start compilation."
1124 (interactive)
1125 (flymake-stop-all-syntax-checks)
1126 (call-interactively 'compile))
1127
1128(defun flymake-on-timer-event (buffer)
1129 "Start a syntax check for buffer BUFFER if necessary."
1130 (when (buffer-live-p buffer)
1131 (with-current-buffer buffer
1132 (when (and (not flymake-is-running)
1133 flymake-last-change-time
1134 (> (- (float-time) flymake-last-change-time)
1135 flymake-no-changes-timeout))
1136
1137 (setq flymake-last-change-time nil)
1138 (flymake-log 3 "starting syntax check as more than 1 second passed since last change")
1139 (flymake-start-syntax-check)))))
1140
1141(define-obsolete-function-alias 'flymake-display-err-menu-for-current-line
1142 'flymake-popup-current-error-menu "24.4")
1143
1144(defun flymake-popup-current-error-menu (&optional event)
1145 "Pop up a menu with errors/warnings for current line."
1146 (interactive (list last-nonmenu-event))
1147 (let* ((line-no (line-number-at-pos))
1148 (errors (or (car (flymake-find-err-info flymake-err-info line-no))
1149 (user-error "No errors for current line")))
1150 (menu (mapcar (lambda (x)
1151 (if (flymake-ler-file x)
1152 (cons (format "%s - %s(%d)"
1153 (flymake-ler-text x)
1154 (flymake-ler-file x)
1155 (flymake-ler-line x))
1156 x)
1157 (list (flymake-ler-text x))))
1158 errors))
1159 (event (if (mouse-event-p event)
1160 event
1161 (list 'mouse-1 (posn-at-point))))
1162 (title (format "Line %d: %d error(s), %d warning(s)"
1163 line-no
1164 (flymake-get-line-err-count errors "e")
1165 (flymake-get-line-err-count errors "w")))
1166 (choice (x-popup-menu event (list title (cons "" menu)))))
1167 (flymake-log 3 "choice=%s" choice)
1168 (when choice
1169 (flymake-goto-file-and-line (flymake-ler-full-file choice)
1170 (flymake-ler-line choice)))))
1171
1172(defun flymake-goto-file-and-line (file line)
1173 "Try to get buffer for FILE and goto line LINE in it."
1174 (if (not (file-exists-p file))
1175 (flymake-log 1 "File %s does not exist" file)
1176 (find-file file)
1177 (goto-char (point-min))
1178 (forward-line (1- line))))
1179
1180;; flymake minor mode declarations
1181(defvar-local flymake-mode-line nil)
1182(defvar-local flymake-mode-line-e-w nil)
1183(defvar-local flymake-mode-line-status nil)
1184
1185(defun flymake-report-status (e-w &optional status)
1186 "Show status in mode line."
1187 (when e-w
1188 (setq flymake-mode-line-e-w e-w))
1189 (when status
1190 (setq flymake-mode-line-status status))
1191 (let* ((mode-line " Flymake"))
1192 (when (> (length flymake-mode-line-e-w) 0)
1193 (setq mode-line (concat mode-line ":" flymake-mode-line-e-w)))
1194 (setq mode-line (concat mode-line flymake-mode-line-status))
1195 (setq flymake-mode-line mode-line)
1196 (force-mode-line-update)))
1197
1198;; Nothing in flymake uses this at all any more, so this is just for
1199;; third-party compatibility.
1200(define-obsolete-function-alias 'flymake-display-warning 'message-box "26.1")
1201
1202(defun flymake-report-fatal-status (status warning)
1203 "Display a warning and switch flymake mode off."
1204 ;; This first message was always shown by default, and flymake-log
1205 ;; does nothing by default, hence the use of message.
1206 ;; Another option is display-warning.
1207 (if (< flymake-log-level 0)
1208 (message "Flymake: %s. Flymake will be switched OFF" warning))
1209 (flymake-mode 0)
1210 (flymake-log 0 "switched OFF Flymake mode for buffer %s due to fatal status %s, warning %s"
1211 (buffer-name) status warning))
1212
1213;;;###autoload
1214(define-minor-mode flymake-mode nil
1215 :group 'flymake :lighter flymake-mode-line
1216 (cond
1217
1218 ;; Turning the mode ON.
1219 (flymake-mode
1220 (cond
1221 ((not buffer-file-name)
1222 (message "Flymake unable to run without a buffer file name"))
1223 ((not (flymake-can-syntax-check-file buffer-file-name))
1224 (flymake-log 2 "flymake cannot check syntax in buffer %s" (buffer-name)))
1225 (t
1226 (add-hook 'after-change-functions 'flymake-after-change-function nil t)
1227 (add-hook 'after-save-hook 'flymake-after-save-hook nil t)
1228 (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
1229 ;;+(add-hook 'find-file-hook 'flymake-find-file-hook)
1230
1231 (flymake-report-status "" "")
1232
1233 (setq flymake-timer
1234 (run-at-time nil 1 'flymake-on-timer-event (current-buffer)))
1235
1236 (when (and flymake-start-syntax-check-on-find-file
1237 ;; Since we write temp files in current dir, there's no point
1238 ;; trying if the directory is read-only (bug#8954).
1239 (file-writable-p (file-name-directory buffer-file-name)))
1240 (with-demoted-errors
1241 (flymake-start-syntax-check))))))
1242
1243 ;; Turning the mode OFF.
1244 (t
1245 (remove-hook 'after-change-functions 'flymake-after-change-function t)
1246 (remove-hook 'after-save-hook 'flymake-after-save-hook t)
1247 (remove-hook 'kill-buffer-hook 'flymake-kill-buffer-hook t)
1248 ;;+(remove-hook 'find-file-hook (function flymake-find-file-hook) t)
1249
1250 (flymake-delete-own-overlays)
1251
1252 (when flymake-timer
1253 (cancel-timer flymake-timer)
1254 (setq flymake-timer nil))
1255
1256 (setq flymake-is-running nil))))
1257
1258;;;###autoload
1259(defun flymake-mode-on ()
1260 "Turn flymake mode on."
1261 (flymake-mode 1)
1262 (flymake-log 1 "flymake mode turned ON for buffer %s" (buffer-name)))
1263
1264;;;###autoload
1265(defun flymake-mode-off ()
1266 "Turn flymake mode off."
1267 (flymake-mode 0)
1268 (flymake-log 1 "flymake mode turned OFF for buffer %s" (buffer-name)))
1269
1270(defun flymake-after-change-function (start stop _len)
1271 "Start syntax check for current buffer if it isn't already running."
1272 ;;+(flymake-log 0 "setting change time to %s" (float-time))
1273 (let((new-text (buffer-substring start stop)))
1274 (when (and flymake-start-syntax-check-on-newline (equal new-text "\n"))
1275 (flymake-log 3 "starting syntax check as new-line has been seen")
1276 (flymake-start-syntax-check))
1277 (setq flymake-last-change-time (float-time))))
1278
1279(defun flymake-after-save-hook ()
1280 (if (local-variable-p 'flymake-mode (current-buffer)) ; (???) other way to determine whether flymake is active in buffer being saved?
1281 (progn
1282 (flymake-log 3 "starting syntax check as buffer was saved")
1283 (flymake-start-syntax-check)))) ; no more mode 3. cannot start check if mode 3 (to temp copies) is active - (???)
1284
1285(defun flymake-kill-buffer-hook ()
1286 (when flymake-timer
1287 (cancel-timer flymake-timer)
1288 (setq flymake-timer nil)))
1289
1290;;;###autoload
1291(defun flymake-find-file-hook ()
1292 ;;+(when flymake-start-syntax-check-on-find-file
1293 ;;+ (flymake-log 3 "starting syntax check on file open")
1294 ;;+ (flymake-start-syntax-check)
1295 ;;+)
1296 (when (and (not (local-variable-p 'flymake-mode (current-buffer)))
1297 (flymake-can-syntax-check-file buffer-file-name))
1298 (flymake-mode)
1299 (flymake-log 3 "automatically turned ON flymake mode")))
1300
1301(defun flymake-get-first-err-line-no (err-info-list)
1302 "Return first line with error."
1303 (when err-info-list
1304 (flymake-er-get-line (car err-info-list))))
1305
1306(defun flymake-get-last-err-line-no (err-info-list)
1307 "Return last line with error."
1308 (when err-info-list
1309 (flymake-er-get-line (nth (1- (length err-info-list)) err-info-list))))
1310
1311(defun flymake-get-next-err-line-no (err-info-list line-no)
1312 "Return next line with error."
1313 (when err-info-list
1314 (let* ((count (length err-info-list))
1315 (idx 0))
1316 (while (and (< idx count) (>= line-no (flymake-er-get-line (nth idx err-info-list))))
1317 (setq idx (1+ idx)))
1318 (if (< idx count)
1319 (flymake-er-get-line (nth idx err-info-list))))))
1320
1321(defun flymake-get-prev-err-line-no (err-info-list line-no)
1322 "Return previous line with error."
1323 (when err-info-list
1324 (let* ((count (length err-info-list)))
1325 (while (and (> count 0) (<= line-no (flymake-er-get-line (nth (1- count) err-info-list))))
1326 (setq count (1- count)))
1327 (if (> count 0)
1328 (flymake-er-get-line (nth (1- count) err-info-list))))))
1329
1330(defun flymake-skip-whitespace ()
1331 "Move forward until non-whitespace is reached."
1332 (while (looking-at "[ \t]")
1333 (forward-char)))
1334
1335(defun flymake-goto-line (line-no)
1336 "Go to line LINE-NO, then skip whitespace."
1337 (goto-char (point-min))
1338 (forward-line (1- line-no))
1339 (flymake-skip-whitespace))
1340
1341(defun flymake-goto-next-error ()
1342 "Go to next error in err ring."
1343 (interactive)
1344 (let ((line-no (flymake-get-next-err-line-no flymake-err-info (line-number-at-pos))))
1345 (when (not line-no)
1346 (setq line-no (flymake-get-first-err-line-no flymake-err-info))
1347 (flymake-log 1 "passed end of file"))
1348 (if line-no
1349 (flymake-goto-line line-no)
1350 (flymake-log 1 "no errors in current buffer"))))
1351
1352(defun flymake-goto-prev-error ()
1353 "Go to previous error in err ring."
1354 (interactive)
1355 (let ((line-no (flymake-get-prev-err-line-no flymake-err-info (line-number-at-pos))))
1356 (when (not line-no)
1357 (setq line-no (flymake-get-last-err-line-no flymake-err-info))
1358 (flymake-log 1 "passed beginning of file"))
1359 (if line-no
1360 (flymake-goto-line line-no)
1361 (flymake-log 1 "no errors in current buffer"))))
1362
1363(defun flymake-patch-err-text (string)
1364 (if (string-match "^[\n\t :0-9]*\\(.*\\)$" string)
1365 (match-string 1 string)
1366 string))
1367
1368;;;; general init-cleanup and helper routines
1369(defun flymake-create-temp-inplace (file-name prefix)
1370 (unless (stringp file-name)
1371 (error "Invalid file-name"))
1372 (or prefix
1373 (setq prefix "flymake"))
1374 (let* ((ext (file-name-extension file-name))
1375 (temp-name (file-truename
1376 (concat (file-name-sans-extension file-name)
1377 "_" prefix
1378 (and ext (concat "." ext))))))
1379 (flymake-log 3 "create-temp-inplace: file=%s temp=%s" file-name temp-name)
1380 temp-name))
1381
1382(defun flymake-create-temp-with-folder-structure (file-name _prefix)
1383 (unless (stringp file-name)
1384 (error "Invalid file-name"))
1385
1386 (let* ((dir (file-name-directory file-name))
1387 ;; Not sure what this slash-pos is all about, but I guess it's just
1388 ;; trying to remove the leading / of absolute file names.
1389 (slash-pos (string-match "/" dir))
1390 (temp-dir (expand-file-name (substring dir (1+ slash-pos))
1391 temporary-file-directory)))
1392
1393 (file-truename (expand-file-name (file-name-nondirectory file-name)
1394 temp-dir))))
1395
1396(defun flymake-delete-temp-directory (dir-name)
1397 "Attempt to delete temp dir created by `flymake-create-temp-with-folder-structure', do not fail on error."
1398 (let* ((temp-dir temporary-file-directory)
1399 (suffix (substring dir-name (1+ (length temp-dir)))))
1400
1401 (while (> (length suffix) 0)
1402 (setq suffix (directory-file-name suffix))
1403 ;;+(flymake-log 0 "suffix=%s" suffix)
1404 (flymake-safe-delete-directory
1405 (file-truename (expand-file-name suffix temp-dir)))
1406 (setq suffix (file-name-directory suffix)))))
1407
1408(defvar-local flymake-temp-source-file-name nil)
1409(defvar-local flymake-master-file-name nil)
1410(defvar-local flymake-temp-master-file-name nil)
1411(defvar-local flymake-base-dir nil)
1412
1413(defun flymake-init-create-temp-buffer-copy (create-temp-f)
1414 "Make a temporary copy of the current buffer, save its name in buffer data and return the name."
1415 (let* ((source-file-name buffer-file-name)
1416 (temp-source-file-name (funcall create-temp-f source-file-name "flymake")))
1417
1418 (flymake-save-buffer-in-file temp-source-file-name)
1419 (setq flymake-temp-source-file-name temp-source-file-name)
1420 temp-source-file-name))
1421
1422(defun flymake-simple-cleanup ()
1423 "Do cleanup after `flymake-init-create-temp-buffer-copy'.
1424Delete temp file."
1425 (flymake-safe-delete-file flymake-temp-source-file-name)
1426 (setq flymake-last-change-time nil))
1427
1428(defun flymake-get-real-file-name (file-name-from-err-msg)
1429 "Translate file name from error message to \"real\" file name.
1430Return full-name. Names are real, not patched."
1431 (let* ((real-name nil)
1432 (source-file-name buffer-file-name)
1433 (master-file-name flymake-master-file-name)
1434 (temp-source-file-name flymake-temp-source-file-name)
1435 (temp-master-file-name flymake-temp-master-file-name)
1436 (base-dirs
1437 (list flymake-base-dir
1438 (file-name-directory source-file-name)
1439 (if master-file-name (file-name-directory master-file-name))))
1440 (files (list (list source-file-name source-file-name)
1441 (list temp-source-file-name source-file-name)
1442 (list master-file-name master-file-name)
1443 (list temp-master-file-name master-file-name))))
1444
1445 (when (equal 0 (length file-name-from-err-msg))
1446 (setq file-name-from-err-msg source-file-name))
1447
1448 (setq real-name (flymake-get-full-patched-file-name file-name-from-err-msg base-dirs files))
1449 ;; if real-name is nil, than file name from err msg is none of the files we've patched
1450 (if (not real-name)
1451 (setq real-name (flymake-get-full-nonpatched-file-name file-name-from-err-msg base-dirs)))
1452 (if (not real-name)
1453 (setq real-name file-name-from-err-msg))
1454 (setq real-name (flymake-fix-file-name real-name))
1455 (flymake-log 3 "get-real-file-name: file-name=%s real-name=%s" file-name-from-err-msg real-name)
1456 real-name))
1457
1458(defun flymake-get-full-patched-file-name (file-name-from-err-msg base-dirs files)
1459 (let* ((base-dirs-count (length base-dirs))
1460 (file-count (length files))
1461 (real-name nil))
1462
1463 (while (and (not real-name) (> base-dirs-count 0))
1464 (setq file-count (length files))
1465 (while (and (not real-name) (> file-count 0))
1466 (let* ((this-dir (nth (1- base-dirs-count) base-dirs))
1467 (this-file (nth 0 (nth (1- file-count) files)))
1468 (this-real-name (nth 1 (nth (1- file-count) files))))
1469 ;;+(flymake-log 0 "this-dir=%s this-file=%s this-real=%s msg-file=%s" this-dir this-file this-real-name file-name-from-err-msg)
1470 (when (and this-dir this-file (flymake-same-files
1471 (expand-file-name file-name-from-err-msg this-dir)
1472 this-file))
1473 (setq real-name this-real-name)))
1474 (setq file-count (1- file-count)))
1475 (setq base-dirs-count (1- base-dirs-count)))
1476 real-name))
1477
1478(defun flymake-get-full-nonpatched-file-name (file-name-from-err-msg base-dirs)
1479 (let* ((real-name nil))
1480 (if (file-name-absolute-p file-name-from-err-msg)
1481 (setq real-name file-name-from-err-msg)
1482 (let* ((base-dirs-count (length base-dirs)))
1483 (while (and (not real-name) (> base-dirs-count 0))
1484 (let* ((full-name (expand-file-name file-name-from-err-msg
1485 (nth (1- base-dirs-count) base-dirs))))
1486 (if (file-exists-p full-name)
1487 (setq real-name full-name))
1488 (setq base-dirs-count (1- base-dirs-count))))))
1489 real-name))
1490
1491(defun flymake-init-find-buildfile-dir (source-file-name buildfile-name)
1492 "Find buildfile, store its dir in buffer data and return its dir, if found."
1493 (let* ((buildfile-dir
1494 (flymake-find-buildfile buildfile-name
1495 (file-name-directory source-file-name))))
1496 (if buildfile-dir
1497 (setq flymake-base-dir buildfile-dir)
1498 (flymake-log 1 "no buildfile (%s) for %s" buildfile-name source-file-name)
1499 (flymake-report-fatal-status
1500 "NOMK" (format "No buildfile (%s) found for %s"
1501 buildfile-name source-file-name)))))
1502
1503(defun flymake-init-create-temp-source-and-master-buffer-copy (get-incl-dirs-f create-temp-f master-file-masks include-regexp)
1504 "Find master file (or buffer), create its copy along with a copy of the source file."
1505 (let* ((source-file-name buffer-file-name)
1506 (temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f))
1507 (master-and-temp-master (flymake-create-master-file
1508 source-file-name temp-source-file-name
1509 get-incl-dirs-f create-temp-f
1510 master-file-masks include-regexp)))
1511
1512 (if (not master-and-temp-master)
1513 (progn
1514 (flymake-log 1 "cannot find master file for %s" source-file-name)
1515 (flymake-report-status "!" "") ; NOMASTER
1516 nil)
1517 (setq flymake-master-file-name (nth 0 master-and-temp-master))
1518 (setq flymake-temp-master-file-name (nth 1 master-and-temp-master)))))
1519
1520(defun flymake-master-cleanup ()
1521 (flymake-simple-cleanup)
1522 (flymake-safe-delete-file flymake-temp-master-file-name))
1523
1524;;;; make-specific init-cleanup routines
1525(defun flymake-get-syntax-check-program-args (source-file-name base-dir use-relative-base-dir use-relative-source get-cmd-line-f)
1526 "Create a command line for syntax check using GET-CMD-LINE-F."
1527 (funcall get-cmd-line-f
1528 (if use-relative-source
1529 (file-relative-name source-file-name base-dir)
1530 source-file-name)
1531 (if use-relative-base-dir
1532 (file-relative-name base-dir
1533 (file-name-directory source-file-name))
1534 base-dir)))
1535
1536(defun flymake-get-make-cmdline (source base-dir)
1537 (list "make"
1538 (list "-s"
1539 "-C"
1540 base-dir
1541 (concat "CHK_SOURCES=" source)
1542 "SYNTAX_CHECK_MODE=1"
1543 "check-syntax")))
1544
1545(defun flymake-get-ant-cmdline (source base-dir)
1546 (list "ant"
1547 (list "-buildfile"
1548 (concat base-dir "/" "build.xml")
1549 (concat "-DCHK_SOURCES=" source)
1550 "check-syntax")))
1551
1552(defun flymake-simple-make-init-impl (create-temp-f use-relative-base-dir use-relative-source build-file-name get-cmdline-f)
1553 "Create syntax check command line for a directly checked source file.
1554Use CREATE-TEMP-F for creating temp copy."
1555 (let* ((args nil)
1556 (source-file-name buffer-file-name)
1557 (buildfile-dir (flymake-init-find-buildfile-dir source-file-name build-file-name)))
1558 (if buildfile-dir
1559 (let* ((temp-source-file-name (flymake-init-create-temp-buffer-copy create-temp-f)))
1560 (setq args (flymake-get-syntax-check-program-args temp-source-file-name buildfile-dir
1561 use-relative-base-dir use-relative-source
1562 get-cmdline-f))))
1563 args))
1564
1565(defun flymake-simple-make-init ()
1566 (flymake-simple-make-init-impl 'flymake-create-temp-inplace t t "Makefile" 'flymake-get-make-cmdline))
1567
1568(defun flymake-master-make-init (get-incl-dirs-f master-file-masks include-regexp)
1569 "Create make command line for a source file checked via master file compilation."
1570 (let* ((make-args nil)
1571 (temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy
1572 get-incl-dirs-f 'flymake-create-temp-inplace
1573 master-file-masks include-regexp)))
1574 (when temp-master-file-name
1575 (let* ((buildfile-dir (flymake-init-find-buildfile-dir temp-master-file-name "Makefile")))
1576 (if buildfile-dir
1577 (setq make-args (flymake-get-syntax-check-program-args
1578 temp-master-file-name buildfile-dir nil nil 'flymake-get-make-cmdline)))))
1579 make-args))
1580
1581(defun flymake-find-make-buildfile (source-dir)
1582 (flymake-find-buildfile "Makefile" source-dir))
1583
1584;;;; .h/make specific
1585(defun flymake-master-make-header-init ()
1586 (flymake-master-make-init
1587 'flymake-get-include-dirs
1588 '("\\.\\(?:c\\(?:pp\\|xx\\|\\+\\+\\)?\\|CC\\)\\'")
1589 "[ \t]*#[ \t]*include[ \t]*\"\\([[:word:]0-9/\\_.]*%s\\)\""))
1590
1591;;;; .java/make specific
1592(defun flymake-simple-make-java-init ()
1593 (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "Makefile" 'flymake-get-make-cmdline))
1594
1595(defun flymake-simple-ant-java-init ()
1596 (flymake-simple-make-init-impl 'flymake-create-temp-with-folder-structure nil nil "build.xml" 'flymake-get-ant-cmdline))
1597
1598(defun flymake-simple-java-cleanup ()
1599 "Cleanup after `flymake-simple-make-java-init' -- delete temp file and dirs."
1600 (flymake-safe-delete-file flymake-temp-source-file-name)
1601 (when flymake-temp-source-file-name
1602 (flymake-delete-temp-directory
1603 (file-name-directory flymake-temp-source-file-name))))
1604
1605;;;; perl-specific init-cleanup routines
1606(defun flymake-perl-init ()
1607 (let* ((temp-file (flymake-init-create-temp-buffer-copy
1608 'flymake-create-temp-inplace))
1609 (local-file (file-relative-name
1610 temp-file
1611 (file-name-directory buffer-file-name))))
1612 (list "perl" (list "-wc " local-file))))
1613
1614;;;; php-specific init-cleanup routines
1615(defun flymake-php-init ()
1616 (let* ((temp-file (flymake-init-create-temp-buffer-copy
1617 'flymake-create-temp-inplace))
1618 (local-file (file-relative-name
1619 temp-file
1620 (file-name-directory buffer-file-name))))
1621 (list "php" (list "-f" local-file "-l"))))
1622
1623;;;; tex-specific init-cleanup routines
1624(defun flymake-get-tex-args (file-name)
1625 ;;(list "latex" (list "-c-style-errors" file-name))
1626 (list "texify" (list "--pdf" "--tex-option=-c-style-errors" file-name)))
1627
1628(defun flymake-simple-tex-init ()
1629 (flymake-get-tex-args (flymake-init-create-temp-buffer-copy 'flymake-create-temp-inplace)))
1630
1631;; Perhaps there should be a buffer-local variable flymake-master-file
1632;; that people can set to override this stuff. Could inherit from
1633;; the similar AUCTeX variable.
1634(defun flymake-master-tex-init ()
1635 (let* ((temp-master-file-name (flymake-init-create-temp-source-and-master-buffer-copy
1636 'flymake-get-include-dirs-dot 'flymake-create-temp-inplace
1637 '("\\.tex\\'")
1638 "[ \t]*\\in\\(?:put\\|clude\\)[ \t]*{\\(.*%s\\)}")))
1639 (when temp-master-file-name
1640 (flymake-get-tex-args temp-master-file-name))))
1641
1642(defun flymake-get-include-dirs-dot (_base-dir)
1643 '("."))
1644
1645;;;; xml-specific init-cleanup routines
1646(defun flymake-xml-init ()
1647 (list flymake-xml-program
1648 (list "val" (flymake-init-create-temp-buffer-copy
1649 'flymake-create-temp-inplace))))
39 1650
40(provide 'flymake) 1651(provide 'flymake)
41;;; flymake.el ends here 1652;;; flymake.el ends here
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index f3513ced4bb..365191c56b0 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -4271,8 +4271,10 @@ See `python-check-command' for the default."
4271 import inspect 4271 import inspect
4272 try: 4272 try:
4273 str_type = basestring 4273 str_type = basestring
4274 argspec_function = inspect.getargspec
4274 except NameError: 4275 except NameError:
4275 str_type = str 4276 str_type = str
4277 argspec_function = inspect.getfullargspec
4276 if isinstance(obj, str_type): 4278 if isinstance(obj, str_type):
4277 obj = eval(obj, globals()) 4279 obj = eval(obj, globals())
4278 doc = inspect.getdoc(obj) 4280 doc = inspect.getdoc(obj)
@@ -4285,9 +4287,7 @@ See `python-check-command' for the default."
4285 target = obj 4287 target = obj
4286 objtype = 'def' 4288 objtype = 'def'
4287 if target: 4289 if target:
4288 args = inspect.formatargspec( 4290 args = inspect.formatargspec(*argspec_function(target))
4289 *inspect.getargspec(target)
4290 )
4291 name = obj.__name__ 4291 name = obj.__name__
4292 doc = '{objtype} {name}{args}'.format( 4292 doc = '{objtype} {name}{args}'.format(
4293 objtype=objtype, name=name, args=args 4293 objtype=objtype, name=name, args=args
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 0bda8bc275d..14598bcafb9 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -593,11 +593,7 @@ sign. See `sh-feature'."
593 (sexp :format "Evaluate: %v")))) 593 (sexp :format "Evaluate: %v"))))
594 :group 'sh-script) 594 :group 'sh-script)
595 595
596 596(define-obsolete-variable-alias 'sh-indentation 'sh-basic-offset "26.1")
597(defcustom sh-indentation 4
598 "The width for further indentation in Shell-Script mode."
599 :type 'integer
600 :group 'sh-script)
601(put 'sh-indentation 'safe-local-variable 'integerp) 597(put 'sh-indentation 'safe-local-variable 'integerp)
602 598
603(defcustom sh-remember-variable-min 3 599(defcustom sh-remember-variable-min 3
@@ -1617,7 +1613,7 @@ with your script for an edit-interpret-debug cycle."
1617 (setq-local skeleton-pair-alist '((?` _ ?`))) 1613 (setq-local skeleton-pair-alist '((?` _ ?`)))
1618 (setq-local skeleton-pair-filter-function 'sh-quoted-p) 1614 (setq-local skeleton-pair-filter-function 'sh-quoted-p)
1619 (setq-local skeleton-further-elements 1615 (setq-local skeleton-further-elements
1620 '((< '(- (min sh-indentation (current-column)))))) 1616 '((< '(- (min sh-basic-offset (current-column))))))
1621 (setq-local skeleton-filter-function 'sh-feature) 1617 (setq-local skeleton-filter-function 'sh-feature)
1622 (setq-local skeleton-newline-indent-rigidly t) 1618 (setq-local skeleton-newline-indent-rigidly t)
1623 (setq-local defun-prompt-regexp 1619 (setq-local defun-prompt-regexp
@@ -2012,7 +2008,7 @@ May return nil if the line should not be treated as continued."
2012 (forward-line -1) 2008 (forward-line -1)
2013 (if (sh-smie--looking-back-at-continuation-p) 2009 (if (sh-smie--looking-back-at-continuation-p)
2014 (current-indentation) 2010 (current-indentation)
2015 (+ (current-indentation) sh-indentation)))) 2011 (+ (current-indentation) sh-basic-offset))))
2016 (t 2012 (t
2017 ;; Just make sure a line-continuation is indented deeper. 2013 ;; Just make sure a line-continuation is indented deeper.
2018 (save-excursion 2014 (save-excursion
@@ -2033,13 +2029,13 @@ May return nil if the line should not be treated as continued."
2033 ;; check the line before that one. 2029 ;; check the line before that one.
2034 (> ci indent)) 2030 (> ci indent))
2035 (t ;Previous line is the beginning of the continued line. 2031 (t ;Previous line is the beginning of the continued line.
2036 (setq indent (min (+ ci sh-indentation) max)) 2032 (setq indent (min (+ ci sh-basic-offset) max))
2037 nil))))) 2033 nil)))))
2038 indent)))))) 2034 indent))))))
2039 2035
2040(defun sh-smie-sh-rules (kind token) 2036(defun sh-smie-sh-rules (kind token)
2041 (pcase (cons kind token) 2037 (pcase (cons kind token)
2042 (`(:elem . basic) sh-indentation) 2038 (`(:elem . basic) sh-basic-offset)
2043 (`(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt) 2039 (`(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt)
2044 (sh-var-value 'sh-indent-for-case-label))) 2040 (sh-var-value 'sh-indent-for-case-label)))
2045 (`(:before . ,(or `"(" `"{" `"[" "while" "if" "for" "case")) 2041 (`(:before . ,(or `"(" `"{" `"[" "while" "if" "for" "case"))
@@ -2248,8 +2244,8 @@ Point should be before the newline."
2248 2244
2249(defun sh-smie-rc-rules (kind token) 2245(defun sh-smie-rc-rules (kind token)
2250 (pcase (cons kind token) 2246 (pcase (cons kind token)
2251 (`(:elem . basic) sh-indentation) 2247 (`(:elem . basic) sh-basic-offset)
2252 ;; (`(:after . "case") (or sh-indentation smie-indent-basic)) 2248 ;; (`(:after . "case") (or sh-basic-offset smie-indent-basic))
2253 (`(:after . ";") 2249 (`(:after . ";")
2254 (if (smie-rule-parent-p "case") 2250 (if (smie-rule-parent-p "case")
2255 (smie-rule-parent (sh-var-value 'sh-indent-after-case)))) 2251 (smie-rule-parent (sh-var-value 'sh-indent-after-case))))
@@ -2490,7 +2486,7 @@ the value thus obtained, and the result is used instead."
2490 2486
2491(defun sh-basic-indent-line () 2487(defun sh-basic-indent-line ()
2492 "Indent a line for Sh mode (shell script mode). 2488 "Indent a line for Sh mode (shell script mode).
2493Indent as far as preceding non-empty line, then by steps of `sh-indentation'. 2489Indent as far as preceding non-empty line, then by steps of `sh-basic-offset'.
2494Lines containing only comments are considered empty." 2490Lines containing only comments are considered empty."
2495 (interactive) 2491 (interactive)
2496 (let ((previous (save-excursion 2492 (let ((previous (save-excursion
@@ -2514,9 +2510,9 @@ Lines containing only comments are considered empty."
2514 (delete-region (point) 2510 (delete-region (point)
2515 (progn (beginning-of-line) (point))) 2511 (progn (beginning-of-line) (point)))
2516 (if (eolp) 2512 (if (eolp)
2517 (max previous (* (1+ (/ current sh-indentation)) 2513 (max previous (* (1+ (/ current sh-basic-offset))
2518 sh-indentation)) 2514 sh-basic-offset))
2519 (* (1+ (/ current sh-indentation)) sh-indentation)))))) 2515 (* (1+ (/ current sh-basic-offset)) sh-basic-offset))))))
2520 (if (< (current-column) (current-indentation)) 2516 (if (< (current-column) (current-indentation))
2521 (skip-chars-forward " \t")))) 2517 (skip-chars-forward " \t"))))
2522 2518
@@ -3594,6 +3590,10 @@ so that `occur-next' and `occur-prev' will work."
3594(defun sh-learn-buffer-indent (&optional arg) 3590(defun sh-learn-buffer-indent (&optional arg)
3595 "Learn how to indent the buffer the way it currently is. 3591 "Learn how to indent the buffer the way it currently is.
3596 3592
3593If `sh-use-smie' is non-nil, call `smie-config-guess'.
3594Otherwise, run the sh-script specific indent learning command, as
3595decribed below.
3596
3597Output in buffer \"*indent*\" shows any lines which have conflicting 3597Output in buffer \"*indent*\" shows any lines which have conflicting
3598values of a variable, and the final value of all variables learned. 3598values of a variable, and the final value of all variables learned.
3599When called interactively, pop to this buffer automatically if 3599When called interactively, pop to this buffer automatically if
@@ -3610,8 +3610,7 @@ to the value of variable `sh-learn-basic-offset'.
3610 3610
3611Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the 3611Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the
3612function completes. The function is abnormal because it is called 3612function completes. The function is abnormal because it is called
3613with an alist of variables learned. This feature may be changed or 3613with an alist of variables learned.
3614removed in the future.
3615 3614
3616This command can often take a long time to run." 3615This command can often take a long time to run."
3617 (interactive "P") 3616 (interactive "P")
@@ -3809,7 +3808,6 @@ This command can often take a long time to run."
3809 " has" "s have") 3808 " has" "s have")
3810 (if (zerop num-diffs) 3809 (if (zerop num-diffs)
3811 "." ":")))))) 3810 "." ":"))))))
3812 ;; Are abnormal hooks considered bad form?
3813 (run-hook-with-args 'sh-learned-buffer-hook learned-var-list) 3811 (run-hook-with-args 'sh-learned-buffer-hook learned-var-list)
3814 (and (called-interactively-p 'any) 3812 (and (called-interactively-p 'any)
3815 (or sh-popup-occur-buffer (> num-diffs 0)) 3813 (or sh-popup-occur-buffer (> num-diffs 0))
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 623c9c4e07f..80cdcb3f18b 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -928,12 +928,14 @@ IGNORES is a list of glob patterns."
928 files 928 files
929 (expand-file-name dir) 929 (expand-file-name dir)
930 ignores)) 930 ignores))
931 (def default-directory)
931 (buf (get-buffer-create " *xref-grep*")) 932 (buf (get-buffer-create " *xref-grep*"))
932 (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist)) 933 (`(,grep-re ,file-group ,line-group . ,_) (car grep-regexp-alist))
933 (status nil) 934 (status nil)
934 (hits nil)) 935 (hits nil))
935 (with-current-buffer buf 936 (with-current-buffer buf
936 (erase-buffer) 937 (erase-buffer)
938 (setq default-directory def)
937 (setq status 939 (setq status
938 (call-process-shell-command command nil t)) 940 (call-process-shell-command command nil t))
939 (goto-char (point-min)) 941 (goto-char (point-min))
diff --git a/lisp/simple.el b/lisp/simple.el
index 1ffe1810672..469557713d7 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -39,11 +39,11 @@
39 39
40(defcustom shell-command-dont-erase-buffer nil 40(defcustom shell-command-dont-erase-buffer nil
41 "If non-nil, output buffer is not erased between shell commands. 41 "If non-nil, output buffer is not erased between shell commands.
42Also, a non-nil value set the point in the output buffer 42Also, a non-nil value sets the point in the output buffer
43once the command complete. 43once the command completes.
44The value `beg-last-out' set point at the beginning of the output, 44The value `beg-last-out' sets point at the beginning of the output,
45`end-last-out' set point at the end of the buffer, `save-point' 45`end-last-out' sets point at the end of the buffer, `save-point'
46restore the buffer position before the command." 46restores the buffer position before the command."
47 :type '(choice 47 :type '(choice
48 (const :tag "Erase buffer" nil) 48 (const :tag "Erase buffer" nil)
49 (const :tag "Set point to beginning of last output" beg-last-out) 49 (const :tag "Set point to beginning of last output" beg-last-out)
@@ -53,9 +53,9 @@ restore the buffer position before the command."
53 :version "26.1") 53 :version "26.1")
54 54
55(defvar shell-command-saved-pos nil 55(defvar shell-command-saved-pos nil
56 "Point position in the output buffer after command complete. 56 "Point position in the output buffer after command completes.
57It is an alist (BUFFER . POS), where BUFFER is the output 57It is an alist of (BUFFER . POS), where BUFFER is the output
58buffer, and POS is the point position in BUFFER once the command finish. 58buffer, and POS is the point position in BUFFER once the command finishes.
59This variable is used when `shell-command-dont-erase-buffer' is non-nil.") 59This variable is used when `shell-command-dont-erase-buffer' is non-nil.")
60 60
61(defcustom idle-update-delay 0.5 61(defcustom idle-update-delay 0.5
@@ -434,10 +434,6 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
434 ;; Do the rest in post-self-insert-hook, because we want to do it 434 ;; Do the rest in post-self-insert-hook, because we want to do it
435 ;; *before* other functions on that hook. 435 ;; *before* other functions on that hook.
436 (lambda () 436 (lambda ()
437 ;; We are not going to insert any newlines if arg is
438 ;; non-positive.
439 (or (and (numberp arg) (<= arg 0))
440 (cl-assert (eq ?\n (char-before))))
441 ;; Mark the newline(s) `hard'. 437 ;; Mark the newline(s) `hard'.
442 (if use-hard-newlines 438 (if use-hard-newlines
443 (set-hard-newline-properties 439 (set-hard-newline-properties
@@ -456,25 +452,22 @@ A non-nil INTERACTIVE argument means to run the `post-self-insert-hook'."
456 ;; starts a page. 452 ;; starts a page.
457 (or was-page-start 453 (or was-page-start
458 (move-to-left-margin nil t))))) 454 (move-to-left-margin nil t)))))
459 (unwind-protect 455 (if (not interactive)
460 (if (not interactive) 456 ;; FIXME: For non-interactive uses, many calls actually
461 ;; FIXME: For non-interactive uses, many calls actually 457 ;; just want (insert "\n"), so maybe we should do just
462 ;; just want (insert "\n"), so maybe we should do just 458 ;; that, so as to avoid the risk of filling or running
463 ;; that, so as to avoid the risk of filling or running 459 ;; abbrevs unexpectedly.
464 ;; abbrevs unexpectedly. 460 (let ((post-self-insert-hook (list postproc)))
465 (let ((post-self-insert-hook (list postproc))) 461 (self-insert-command arg))
466 (self-insert-command arg)) 462 (unwind-protect
467 (unwind-protect 463 (progn
468 (progn 464 (add-hook 'post-self-insert-hook postproc nil t)
469 (add-hook 'post-self-insert-hook postproc nil t) 465 (self-insert-command arg))
470 (self-insert-command arg)) 466 ;; We first used let-binding to protect the hook, but that
471 ;; We first used let-binding to protect the hook, but that 467 ;; was naive since add-hook affects the symbol-default
472 ;; was naive since add-hook affects the symbol-default 468 ;; value of the variable, whereas the let-binding might
473 ;; value of the variable, whereas the let-binding might 469 ;; only protect the buffer-local value.
474 ;; only protect the buffer-local value. 470 (remove-hook 'post-self-insert-hook postproc t))))
475 (remove-hook 'post-self-insert-hook postproc t)))
476 (cl-assert (not (member postproc post-self-insert-hook)))
477 (cl-assert (not (member postproc (default-value 'post-self-insert-hook))))))
478 nil) 471 nil)
479 472
480(defun set-hard-newline-properties (from to) 473(defun set-hard-newline-properties (from to)
@@ -1010,7 +1003,7 @@ Called with one argument METHOD.
1010If METHOD is `delete-only', then delete the region; the return value 1003If METHOD is `delete-only', then delete the region; the return value
1011is undefined. If METHOD is nil, then return the content as a string. 1004is undefined. If METHOD is nil, then return the content as a string.
1012If METHOD is `bounds', then return the boundaries of the region 1005If METHOD is `bounds', then return the boundaries of the region
1013as a list of the form (START . END). 1006as a list of pairs of (START . END) positions.
1014If METHOD is anything else, delete the region and return its content 1007If METHOD is anything else, delete the region and return its content
1015as a string, after filtering it with `filter-buffer-substring', which 1008as a string, after filtering it with `filter-buffer-substring', which
1016is called with METHOD as its 3rd argument.") 1009is called with METHOD as its 3rd argument.")
@@ -5480,7 +5473,7 @@ also checks the value of `use-empty-active-region'."
5480 (progn (cl-assert (mark)) t))) 5473 (progn (cl-assert (mark)) t)))
5481 5474
5482(defun region-bounds () 5475(defun region-bounds ()
5483 "Return the boundaries of the region as a list of (START . END) positions." 5476 "Return the boundaries of the region as a list of pairs of (START . END) positions."
5484 (funcall region-extract-function 'bounds)) 5477 (funcall region-extract-function 'bounds))
5485 5478
5486(defun region-noncontiguous-p () 5479(defun region-noncontiguous-p ()
diff --git a/lisp/subr.el b/lisp/subr.el
index 79ae1f4830d..cf15ec287ff 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -289,7 +289,7 @@ The name is made by appending `gensym-counter' to PREFIX.
289PREFIX is a string, and defaults to \"g\"." 289PREFIX is a string, and defaults to \"g\"."
290 (let ((num (prog1 gensym-counter 290 (let ((num (prog1 gensym-counter
291 (setq gensym-counter (1+ gensym-counter))))) 291 (setq gensym-counter (1+ gensym-counter)))))
292 (make-symbol (format "%s%d" prefix num)))) 292 (make-symbol (format "%s%d" (or prefix "g") num))))
293 293
294(defun ignore (&rest _ignore) 294(defun ignore (&rest _ignore)
295 "Do nothing and return nil. 295 "Do nothing and return nil.
@@ -1270,6 +1270,11 @@ See `event-start' for a description of the value returned."
1270 "Return the multi-click count of EVENT, a click or drag event. 1270 "Return the multi-click count of EVENT, a click or drag event.
1271The return value is a positive integer." 1271The return value is a positive integer."
1272 (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1)) 1272 (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1))
1273
1274(defsubst event-line-count (event)
1275 "Return the line count of EVENT, a mousewheel event.
1276The return value is a positive integer."
1277 (if (and (consp event) (integerp (nth 3 event))) (nth 3 event) 1))
1273 1278
1274;;;; Extracting fields of the positions in an event. 1279;;;; Extracting fields of the positions in an event.
1275 1280
diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el
index 68b659bf751..bc211ea9589 100644
--- a/lisp/term/ns-win.el
+++ b/lisp/term/ns-win.el
@@ -736,6 +736,25 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.")
736(global-unset-key [horizontal-scroll-bar drag-mouse-1]) 736(global-unset-key [horizontal-scroll-bar drag-mouse-1])
737 737
738 738
739;;;; macOS-like defaults for trackpad and mouse wheel scrolling on
740;;;; macOS 10.7+.
741
742;; FIXME: This doesn't look right. Is there a better way to do this
743;; that keeps customize happy?
744(let ((appkit-version (progn
745 (string-match "^appkit-\\([^\s-]*\\)" ns-version-string)
746 (string-to-number (match-string 1 ns-version-string)))))
747 ;; Appkit 1138 ~= macOS 10.7.
748 (when (and (featurep 'cocoa) (>= appkit-version 1138))
749 (setq mouse-wheel-scroll-amount '(1 ((shift) . 5) ((control))))
750 (put 'mouse-wheel-scroll-amount 'customized-value
751 (list (custom-quote (symbol-value 'mouse-wheel-scroll-amount))))
752
753 (setq mouse-wheel-progressive-speed nil)
754 (put 'mouse-wheel-progressive-speed 'customized-value
755 (list (custom-quote (symbol-value 'mouse-wheel-progressive-speed))))))
756
757
739;;;; Color support. 758;;;; Color support.
740 759
741;; Functions for color panel + drag 760;; Functions for color panel + drag
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index dde9e6a8d91..ce9bbf47e77 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -1578,7 +1578,7 @@ to look up will be substituted there."
1578 (goto-char (point-min)) 1578 (goto-char (point-min))
1579 (let ((window (get-buffer-window (current-buffer) 'visible))) 1579 (let ((window (get-buffer-window (current-buffer) 'visible)))
1580 (when window 1580 (when window
1581 (when (re-search-forward "^Summary" nil 'move) 1581 (when (re-search-forward "^\\(Summary\\|Syntax\\)" nil 'move)
1582 (beginning-of-line) 1582 (beginning-of-line)
1583 (set-window-start window (point)))))) 1583 (set-window-start window (point))))))
1584 1584
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
index 0c0a51e7df0..6a169622f52 100644
--- a/lisp/textmodes/ispell.el
+++ b/lisp/textmodes/ispell.el
@@ -1492,8 +1492,10 @@ This is passed to the Ispell process using the `-p' switch.")
1492 (assoc ispell-current-dictionary ispell-local-dictionary-alist) 1492 (assoc ispell-current-dictionary ispell-local-dictionary-alist)
1493 (assoc ispell-current-dictionary ispell-dictionary-alist) 1493 (assoc ispell-current-dictionary ispell-dictionary-alist)
1494 (error "No data for dictionary \"%s\" in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'" 1494 (error "No data for dictionary \"%s\" in `ispell-local-dictionary-alist' or `ispell-dictionary-alist'"
1495 ispell-current-dictionary)))) 1495 ispell-current-dictionary)))
1496 (decode-coding-string (nth n slot) (ispell-get-coding-system) t))) 1496 (str (nth n slot)))
1497 (if (stringp str)
1498 (decode-coding-string str (ispell-get-coding-system) t))))
1497 1499
1498(defun ispell-get-casechars () 1500(defun ispell-get-casechars ()
1499 (ispell-get-decoded-string 1)) 1501 (ispell-get-decoded-string 1))
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
index d744bd2cf01..94b68decfb7 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -583,6 +583,7 @@ directory for only the accessible portion of the buffer."
583 (with-output-to-temp-buffer pages-directory-buffer 583 (with-output-to-temp-buffer pages-directory-buffer
584 (with-current-buffer standard-output 584 (with-current-buffer standard-output
585 (pages-directory-mode) 585 (pages-directory-mode)
586 (setq buffer-read-only nil)
586 (insert 587 (insert
587 "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n) 588 "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
588 (setq pages-buffer pages-target-buffer) 589 (setq pages-buffer pages-target-buffer)
@@ -631,6 +632,7 @@ directory for only the accessible portion of the buffer."
631 ))))) 632 )))))
632 633
633 (set-buffer standard-output) 634 (set-buffer standard-output)
635 (setq buffer-read-only t)
634 ;; Put positions in increasing order to go with buffer. 636 ;; Put positions in increasing order to go with buffer.
635 (setq pages-pos-list (nreverse pages-pos-list)) 637 (setq pages-pos-list (nreverse pages-pos-list))
636 (if (called-interactively-p 'interactive) 638 (if (called-interactively-p 'interactive)
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index 52f56ed990f..d6963d0a1b9 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -608,10 +608,16 @@ considered file(s)."
608 (log-view-diff-common beg end t))) 608 (log-view-diff-common beg end t)))
609 609
610(defun log-view-diff-common (beg end &optional whole-changeset) 610(defun log-view-diff-common (beg end &optional whole-changeset)
611 (let ((to (log-view-current-tag beg)) 611 (let* ((to (log-view-current-tag beg))
612 (fr (log-view-current-tag end))) 612 (fr-entry (log-view-current-entry end))
613 (when (string-equal fr to) 613 (fr (cadr fr-entry)))
614 ;; TO and FR are the same, look at the previous revision. 614 ;; When TO and FR are the same, or when point is on a line after
615 ;; the last entry, look at the previous revision.
616 (when (or (string-equal fr to)
617 (>= (point)
618 (save-excursion
619 (goto-char (car fr-entry))
620 (forward-line))))
615 (setq fr (vc-call-backend log-view-vc-backend 'previous-revision nil fr))) 621 (setq fr (vc-call-backend log-view-vc-backend 'previous-revision nil fr)))
616 (vc-diff-internal 622 (vc-diff-internal
617 t (list log-view-vc-backend 623 t (list log-view-vc-backend
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 112a9bc5247..91be89b5dc1 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -725,7 +725,7 @@ this keeps \"UUU\"."
725 (let ((i 3)) 725 (let ((i 3))
726 (while (or (not (match-end i)) 726 (while (or (not (match-end i))
727 (< (point) (match-beginning i)) 727 (< (point) (match-beginning i))
728 (>= (point) (match-end i))) 728 (> (point) (match-end i)))
729 (cl-decf i)) 729 (cl-decf i))
730 i)) 730 i))
731 731
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 095f184ddf1..9d7a4d49b8b 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -1035,6 +1035,7 @@ If LIMIT is non-nil, show no more than this many entries."
1035 1035
1036(defun vc-git-log-outgoing (buffer remote-location) 1036(defun vc-git-log-outgoing (buffer remote-location)
1037 (interactive) 1037 (interactive)
1038 (vc-setup-buffer buffer)
1038 (vc-git-command 1039 (vc-git-command
1039 buffer 'async nil 1040 buffer 'async nil
1040 "log" 1041 "log"
@@ -1048,6 +1049,7 @@ If LIMIT is non-nil, show no more than this many entries."
1048 1049
1049(defun vc-git-log-incoming (buffer remote-location) 1050(defun vc-git-log-incoming (buffer remote-location)
1050 (interactive) 1051 (interactive)
1052 (vc-setup-buffer buffer)
1051 (vc-git-command nil 0 nil "fetch") 1053 (vc-git-command nil 0 nil "fetch")
1052 (vc-git-command 1054 (vc-git-command
1053 buffer 'async nil 1055 buffer 'async nil
diff --git a/lisp/xdg.el b/lisp/xdg.el
index e94fa8ec924..76106f42586 100644
--- a/lisp/xdg.el
+++ b/lisp/xdg.el
@@ -84,7 +84,7 @@
84 84
85(defun xdg-thumb-uri (filename) 85(defun xdg-thumb-uri (filename)
86 "Return the canonical URI for FILENAME. 86 "Return the canonical URI for FILENAME.
87If FILENAME has absolute path /foo/bar.jpg, its canonical URI is 87If FILENAME has absolute file name /foo/bar.jpg, its canonical URI is
88file:///foo/bar.jpg" 88file:///foo/bar.jpg"
89 (concat "file://" (expand-file-name filename))) 89 (concat "file://" (expand-file-name filename)))
90 90
@@ -197,8 +197,6 @@ Optional argument GROUP defaults to the string \"Desktop Entry\"."
197 (unless (looking-at xdg-desktop-group-regexp) 197 (unless (looking-at xdg-desktop-group-regexp)
198 (error "Expected group name! Instead saw: %s" 198 (error "Expected group name! Instead saw: %s"
199 (buffer-substring (point) (point-at-eol)))) 199 (buffer-substring (point) (point-at-eol))))
200 (unless (equal (match-string 1) "Desktop Entry")
201 (error "Wrong first group: %s" (match-string 1)))
202 (when group 200 (when group
203 (while (and (re-search-forward xdg-desktop-group-regexp nil t) 201 (while (and (re-search-forward xdg-desktop-group-regexp nil t)
204 (not (equal (match-string 1) group))))) 202 (not (equal (match-string 1) group)))))
diff --git a/m4/alloca.m4 b/m4/alloca.m4
index 7f0604cbdac..d1224316498 100644
--- a/m4/alloca.m4
+++ b/m4/alloca.m4
@@ -44,12 +44,12 @@ AC_DEFUN([gl_FUNC_ALLOCA],
44AC_DEFUN([gl_PREREQ_ALLOCA], [:]) 44AC_DEFUN([gl_PREREQ_ALLOCA], [:])
45 45
46# This works around a bug in autoconf <= 2.68. 46# This works around a bug in autoconf <= 2.68.
47# See <http://lists.gnu.org/archive/html/bug-gnulib/2011-06/msg00277.html>. 47# See <https://lists.gnu.org/archive/html/bug-gnulib/2011-06/msg00277.html>.
48 48
49m4_version_prereq([2.69], [] ,[ 49m4_version_prereq([2.69], [] ,[
50 50
51# This is taken from the following Autoconf patch: 51# This is taken from the following Autoconf patch:
52# http://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=6cd9f12520b0d6f76d3230d7565feba1ecf29497 52# https://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=6cd9f12520b0d6f76d3230d7565feba1ecf29497
53 53
54# _AC_LIBOBJ_ALLOCA 54# _AC_LIBOBJ_ALLOCA
55# ----------------- 55# -----------------
diff --git a/m4/extern-inline.m4 b/m4/extern-inline.m4
index 00f960968b0..c08af18af68 100644
--- a/m4/extern-inline.m4
+++ b/m4/extern-inline.m4
@@ -11,7 +11,7 @@ AC_DEFUN([gl_EXTERN_INLINE],
11[/* Please see the Gnulib manual for how to use these macros. 11[/* Please see the Gnulib manual for how to use these macros.
12 12
13 Suppress extern inline with HP-UX cc, as it appears to be broken; see 13 Suppress extern inline with HP-UX cc, as it appears to be broken; see
14 <http://lists.gnu.org/archive/html/bug-texinfo/2013-02/msg00030.html>. 14 <https://lists.gnu.org/archive/html/bug-texinfo/2013-02/msg00030.html>.
15 15
16 Suppress extern inline with Sun C in standards-conformance mode, as it 16 Suppress extern inline with Sun C in standards-conformance mode, as it
17 mishandles inline functions that call each other. E.g., for 'inline void f 17 mishandles inline functions that call each other. E.g., for 'inline void f
@@ -28,16 +28,16 @@ AC_DEFUN([gl_EXTERN_INLINE],
28 from calling static functions. This bug is known to occur on: 28 from calling static functions. This bug is known to occur on:
29 29
30 OS X 10.8 and earlier; see: 30 OS X 10.8 and earlier; see:
31 http://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html 31 https://lists.gnu.org/archive/html/bug-gnulib/2012-12/msg00023.html
32 32
33 DragonFly; see 33 DragonFly; see
34 http://muscles.dragonflybsd.org/bulk/bleeding-edge-potential/latest-per-pkg/ah-tty-0.3.12.log 34 http://muscles.dragonflybsd.org/bulk/bleeding-edge-potential/latest-per-pkg/ah-tty-0.3.12.log
35 35
36 FreeBSD; see: 36 FreeBSD; see:
37 http://lists.gnu.org/archive/html/bug-gnulib/2014-07/msg00104.html 37 https://lists.gnu.org/archive/html/bug-gnulib/2014-07/msg00104.html
38 38
39 OS X 10.9 has a macro __header_inline indicating the bug is fixed for C and 39 OS X 10.9 has a macro __header_inline indicating the bug is fixed for C and
40 for clang but remains for g++; see <http://trac.macports.org/ticket/41033>. 40 for clang but remains for g++; see <https://trac.macports.org/ticket/41033>.
41 Assume DragonFly and FreeBSD will be similar. */ 41 Assume DragonFly and FreeBSD will be similar. */
42#if (((defined __APPLE__ && defined __MACH__) \ 42#if (((defined __APPLE__ && defined __MACH__) \
43 || defined __DragonFly__ || defined __FreeBSD__) \ 43 || defined __DragonFly__ || defined __FreeBSD__) \
diff --git a/m4/fstatat.m4 b/m4/fstatat.m4
index 75cf0110401..b29ec9258e9 100644
--- a/m4/fstatat.m4
+++ b/m4/fstatat.m4
@@ -20,7 +20,7 @@ AC_DEFUN([gl_FUNC_FSTATAT],
20 HAVE_FSTATAT=0 20 HAVE_FSTATAT=0
21 else 21 else
22 dnl Test for an AIX 7.1 bug; see 22 dnl Test for an AIX 7.1 bug; see
23 dnl <http://lists.gnu.org/archive/html/bug-tar/2011-09/msg00015.html>. 23 dnl <https://lists.gnu.org/archive/html/bug-tar/2011-09/msg00015.html>.
24 AC_CACHE_CHECK([whether fstatat (..., 0) works], 24 AC_CACHE_CHECK([whether fstatat (..., 0) works],
25 [gl_cv_func_fstatat_zero_flag], 25 [gl_cv_func_fstatat_zero_flag],
26 [AC_RUN_IFELSE( 26 [AC_RUN_IFELSE(
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index 36f2acc5539..36da841287d 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -228,13 +228,13 @@ m4_ifndef([AS_VAR_IF],
228# This is like AC_PROG_CC_C99, except that 228# This is like AC_PROG_CC_C99, except that
229# - AC_PROG_CC_C99 did not exist in Autoconf versions < 2.60, 229# - AC_PROG_CC_C99 did not exist in Autoconf versions < 2.60,
230# - AC_PROG_CC_C99 does not mix well with AC_PROG_CC_STDC 230# - AC_PROG_CC_C99 does not mix well with AC_PROG_CC_STDC
231# <http://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00367.html>, 231# <https://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00367.html>,
232# but many more packages use AC_PROG_CC_STDC than AC_PROG_CC_C99 232# but many more packages use AC_PROG_CC_STDC than AC_PROG_CC_C99
233# <http://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00441.html>. 233# <https://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00441.html>.
234# Remaining problems: 234# Remaining problems:
235# - When AC_PROG_CC_STDC is invoked twice, it adds the C99 enabling options 235# - When AC_PROG_CC_STDC is invoked twice, it adds the C99 enabling options
236# to CC twice 236# to CC twice
237# <http://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00431.html>. 237# <https://lists.gnu.org/archive/html/bug-gnulib/2011-09/msg00431.html>.
238# - AC_PROG_CC_STDC is likely to change now that C11 is an ISO standard. 238# - AC_PROG_CC_STDC is likely to change now that C11 is an ISO standard.
239AC_DEFUN([gl_PROG_CC_C99], 239AC_DEFUN([gl_PROG_CC_C99],
240[ 240[
diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4
index eb89325519c..d10bcd08a0e 100644
--- a/m4/manywarnings.m4
+++ b/m4/manywarnings.m4
@@ -1,4 +1,4 @@
1# manywarnings.m4 serial 12 1# manywarnings.m4 serial 13
2dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. 2dnl Copyright (C) 2008-2017 Free Software Foundation, Inc.
3dnl This file is free software; the Free Software Foundation 3dnl This file is free software; the Free Software Foundation
4dnl gives unlimited permission to copy and/or distribute it, 4dnl gives unlimited permission to copy and/or distribute it,
@@ -267,18 +267,23 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
267 267
268 # gcc --help=warnings outputs an unusual form for these options; list 268 # gcc --help=warnings outputs an unusual form for these options; list
269 # them here so that the above 'comm' command doesn't report a false match. 269 # them here so that the above 'comm' command doesn't report a false match.
270 # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal 270 # Would prefer "min (PTRDIFF_MAX, SIZE_MAX)", but it must be a literal.
271 # and AC_COMPUTE_INT requires it to fit in a long: 271 # Also, AC_COMPUTE_INT requires it to fit in a long; it is 2**63 on
272 # the only platforms where it does not fit in a long, so make that
273 # a special case.
272 AC_MSG_CHECKING([max safe object size]) 274 AC_MSG_CHECKING([max safe object size])
273 AC_COMPUTE_INT([gl_alloc_max], 275 AC_COMPUTE_INT([gl_alloc_max],
274 [(LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX) < (size_t) -1 276 [LONG_MAX < (PTRDIFF_MAX < (size_t) -1 ? PTRDIFF_MAX : (size_t) -1)
275 ? (LONG_MAX < PTRDIFF_MAX ? LONG_MAX : PTRDIFF_MAX) 277 ? -1
276 : (size_t) -1], 278 : PTRDIFF_MAX < (size_t) -1 ? (long) PTRDIFF_MAX : (long) (size_t) -1],
277 [[#include <limits.h> 279 [[#include <limits.h>
278 #include <stddef.h> 280 #include <stddef.h>
279 #include <stdint.h> 281 #include <stdint.h>
280 ]], 282 ]],
281 [gl_alloc_max=2147483647]) 283 [gl_alloc_max=2147483647])
284 case $gl_alloc_max in
285 -1) gl_alloc_max=9223372036854775807;;
286 esac
282 AC_MSG_RESULT([$gl_alloc_max]) 287 AC_MSG_RESULT([$gl_alloc_max])
283 gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$gl_alloc_max" 288 gl_manywarn_set="$gl_manywarn_set -Walloc-size-larger-than=$gl_alloc_max"
284 gl_manywarn_set="$gl_manywarn_set -Warray-bounds=2" 289 gl_manywarn_set="$gl_manywarn_set -Warray-bounds=2"
diff --git a/m4/std-gnu11.m4 b/m4/std-gnu11.m4
index bd34aa1a268..3c2f26f4666 100644
--- a/m4/std-gnu11.m4
+++ b/m4/std-gnu11.m4
@@ -369,7 +369,7 @@ dnl just the module. Instead, define the (private) symbol
369dnl _STDC_C99, which suppresses a bogus failure in <stdbool.h>. 369dnl _STDC_C99, which suppresses a bogus failure in <stdbool.h>.
370dnl The resulting compiler passes the test case here, and that's 370dnl The resulting compiler passes the test case here, and that's
371dnl good enough. For more, please see the thread starting at: 371dnl good enough. For more, please see the thread starting at:
372dnl http://lists.gnu.org/archive/html/autoconf/2010-12/msg00059.html 372dnl https://lists.gnu.org/archive/html/autoconf/2010-12/msg00059.html
373dnl Tru64 -c99 373dnl Tru64 -c99
374dnl with extended modes being tried first. 374dnl with extended modes being tried first.
375[[-std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc1x -qlanglvl=extc99]], [$1], [$2])[]dnl 375[[-std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc1x -qlanglvl=extc99]], [$1], [$2])[]dnl
@@ -458,7 +458,7 @@ dnl preferably extc11.
458# -------------- 458# --------------
459# Do not use AU_ALIAS here and in AC_PROG_CC_C99 and AC_PROG_CC_STDC, 459# Do not use AU_ALIAS here and in AC_PROG_CC_C99 and AC_PROG_CC_STDC,
460# as that'd be incompatible with how Automake redefines AC_PROG_CC. See 460# as that'd be incompatible with how Automake redefines AC_PROG_CC. See
461# <http://lists.gnu.org/archive/html/autoconf/2012-10/msg00048.html>. 461# <https://lists.gnu.org/archive/html/autoconf/2012-10/msg00048.html>.
462AU_DEFUN([AC_PROG_CC_C89], 462AU_DEFUN([AC_PROG_CC_C89],
463 [AC_REQUIRE([AC_PROG_CC])], 463 [AC_REQUIRE([AC_PROG_CC])],
464 [$0 is obsolete; use AC_PROG_CC] 464 [$0 is obsolete; use AC_PROG_CC]
diff --git a/m4/sys_types_h.m4 b/m4/sys_types_h.m4
index 34224d7705d..06268cfb2db 100644
--- a/m4/sys_types_h.m4
+++ b/m4/sys_types_h.m4
@@ -40,7 +40,7 @@ AC_DEFUN([gl_SYS_TYPES_H_DEFAULTS],
40m4_version_prereq([2.70], [], [ 40m4_version_prereq([2.70], [], [
41 41
42# This is taken from the following Autoconf patch: 42# This is taken from the following Autoconf patch:
43# https://git.sv.gnu.org/cgit/autoconf.git/commit/?id=e17a30e98 43# http://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=e17a30e987d7ee695fb4294a82d987ec3dc9b974
44 44
45m4_undefine([AC_HEADER_MAJOR]) 45m4_undefine([AC_HEADER_MAJOR])
46AC_DEFUN([AC_HEADER_MAJOR], 46AC_DEFUN([AC_HEADER_MAJOR],
diff --git a/m4/vararrays.m4 b/m4/vararrays.m4
index 8391121ad3f..38a3ed23542 100644
--- a/m4/vararrays.m4
+++ b/m4/vararrays.m4
@@ -27,7 +27,7 @@ AC_DEFUN([AC_C_VARARRAYS],
27 [[/* Test for VLA support. This test is partly inspired 27 [[/* Test for VLA support. This test is partly inspired
28 from examples in the C standard. Use at least two VLA 28 from examples in the C standard. Use at least two VLA
29 functions to detect the GCC 3.4.3 bug described in: 29 functions to detect the GCC 3.4.3 bug described in:
30 http://lists.gnu.org/archive/html/bug-gnulib/2014-08/msg00014.html 30 https://lists.gnu.org/archive/html/bug-gnulib/2014-08/msg00014.html
31 */ 31 */
32 #ifdef __STDC_NO_VLA__ 32 #ifdef __STDC_NO_VLA__
33 syntax error; 33 syntax error;
diff --git a/src/Makefile.in b/src/Makefile.in
index 0e55ad4bb29..9a8c9c85f04 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -280,7 +280,7 @@ GNU_OBJC_CFLAGS=$(patsubst -specs=%-hardened-cc1,,@GNU_OBJC_CFLAGS@)
280## w32xfns.o w32select.o image.o w32uniscribe.o if HAVE_W32, else 280## w32xfns.o w32select.o image.o w32uniscribe.o if HAVE_W32, else
281## empty. 281## empty.
282W32_OBJ=@W32_OBJ@ 282W32_OBJ=@W32_OBJ@
283## -lkernel32 -luser32 -lgdi32 -lole32 -lcomdlg32 lusp10 -lcomctl32 283## -lkernel32 -luser32 -lusp10 -lgdi32 -lole32 -lcomdlg32 -lcomctl32
284## --lwinspool if HAVE_W32, else empty. 284## --lwinspool if HAVE_W32, else empty.
285W32_LIBS=@W32_LIBS@ 285W32_LIBS=@W32_LIBS@
286 286
diff --git a/src/callint.c b/src/callint.c
index 105ec071d07..469205cc380 100644
--- a/src/callint.c
+++ b/src/callint.c
@@ -272,7 +272,7 @@ invoke it. If KEYS is omitted or nil, the return value of
272{ 272{
273 /* `args' will contain the array of arguments to pass to the function. 273 /* `args' will contain the array of arguments to pass to the function.
274 `visargs' will contain the same list but in a nicer form, so that if we 274 `visargs' will contain the same list but in a nicer form, so that if we
275 pass it to `Fformat_message' it will be understandable to a human. */ 275 pass it to styled_format it will be understandable to a human. */
276 Lisp_Object *args, *visargs; 276 Lisp_Object *args, *visargs;
277 Lisp_Object specs; 277 Lisp_Object specs;
278 Lisp_Object filter_specs; 278 Lisp_Object filter_specs;
@@ -502,10 +502,7 @@ invoke it. If KEYS is omitted or nil, the return value of
502 for (i = 2; *tem; i++) 502 for (i = 2; *tem; i++)
503 { 503 {
504 visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n")); 504 visargs[1] = make_string (tem + 1, strcspn (tem + 1, "\n"));
505 if (strchr (SSDATA (visargs[1]), '%')) 505 callint_message = styled_format (i - 1, visargs + 1, true, false);
506 callint_message = Fformat_message (i - 1, visargs + 1);
507 else
508 callint_message = visargs[1];
509 506
510 switch (*tem) 507 switch (*tem)
511 { 508 {
diff --git a/src/data.c b/src/data.c
index 95bf06e5102..e070be6c208 100644
--- a/src/data.c
+++ b/src/data.c
@@ -3010,16 +3010,16 @@ static Lisp_Object
3010minmax_driver (ptrdiff_t nargs, Lisp_Object *args, 3010minmax_driver (ptrdiff_t nargs, Lisp_Object *args,
3011 enum Arith_Comparison comparison) 3011 enum Arith_Comparison comparison)
3012{ 3012{
3013 eassume (0 < nargs); 3013 Lisp_Object accum = args[0];
3014 Lisp_Object accum = args[0]; /* pacify GCC */ 3014 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (accum);
3015 for (ptrdiff_t argnum = 0; argnum < nargs; argnum++) 3015 for (ptrdiff_t argnum = 1; argnum < nargs; argnum++)
3016 { 3016 {
3017 Lisp_Object val = args[argnum]; 3017 Lisp_Object val = args[argnum];
3018 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val); 3018 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val);
3019 if (argnum == 0 || !NILP (arithcompare (val, accum, comparison))) 3019 if (!NILP (arithcompare (val, accum, comparison)))
3020 accum = val; 3020 accum = val;
3021 else if (FLOATP (accum) && isnan (XFLOAT_DATA (accum))) 3021 else if (FLOATP (val) && isnan (XFLOAT_DATA (val)))
3022 return accum; 3022 return val;
3023 } 3023 }
3024 return accum; 3024 return accum;
3025} 3025}
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 4a7068416fe..789aa008611 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -237,7 +237,8 @@ static char *
237XD_OBJECT_TO_STRING (Lisp_Object object) 237XD_OBJECT_TO_STRING (Lisp_Object object)
238{ 238{
239 AUTO_STRING (format, "%s"); 239 AUTO_STRING (format, "%s");
240 return SSDATA (CALLN (Fformat, format, object)); 240 Lisp_Object args[] = { format, object };
241 return SSDATA (styled_format (ARRAYELTS (args), args, false, false));
241} 242}
242 243
243#define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \ 244#define XD_DBUS_VALIDATE_BUS_ADDRESS(bus) \
diff --git a/src/editfns.c b/src/editfns.c
index b03eb947dec..e326604467c 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -74,7 +74,6 @@ static Lisp_Object format_time_string (char const *, ptrdiff_t, struct timespec,
74static long int tm_gmtoff (struct tm *); 74static long int tm_gmtoff (struct tm *);
75static int tm_diff (struct tm *, struct tm *); 75static int tm_diff (struct tm *, struct tm *);
76static void update_buffer_properties (ptrdiff_t, ptrdiff_t); 76static void update_buffer_properties (ptrdiff_t, ptrdiff_t);
77static Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool);
78 77
79#ifndef HAVE_TM_GMTOFF 78#ifndef HAVE_TM_GMTOFF
80# define HAVE_TM_GMTOFF false 79# define HAVE_TM_GMTOFF false
@@ -187,7 +186,8 @@ tzlookup (Lisp_Object zone, bool settz)
187 if (sec != 0) 186 if (sec != 0)
188 prec += 2, numzone = 100 * numzone + sec; 187 prec += 2, numzone = 100 * numzone + sec;
189 } 188 }
190 sprintf (tzbuf, tzbuf_format, prec, numzone, 189 sprintf (tzbuf, tzbuf_format, prec,
190 XINT (zone) < 0 ? -numzone : numzone,
191 &"-"[XINT (zone) < 0], hour, min, sec); 191 &"-"[XINT (zone) < 0], hour, min, sec);
192 zone_string = tzbuf; 192 zone_string = tzbuf;
193 } 193 }
@@ -3958,7 +3958,7 @@ usage: (message FORMAT-STRING &rest ARGS) */)
3958 } 3958 }
3959 else 3959 else
3960 { 3960 {
3961 Lisp_Object val = Fformat_message (nargs, args); 3961 Lisp_Object val = styled_format (nargs, args, true, false);
3962 message3 (val); 3962 message3 (val);
3963 return val; 3963 return val;
3964 } 3964 }
@@ -3984,7 +3984,7 @@ usage: (message-box FORMAT-STRING &rest ARGS) */)
3984 } 3984 }
3985 else 3985 else
3986 { 3986 {
3987 Lisp_Object val = Fformat_message (nargs, args); 3987 Lisp_Object val = styled_format (nargs, args, true, false);
3988 Lisp_Object pane, menu; 3988 Lisp_Object pane, menu;
3989 3989
3990 pane = list1 (Fcons (build_string ("OK"), Qt)); 3990 pane = list1 (Fcons (build_string ("OK"), Qt));
@@ -4140,7 +4140,7 @@ produced text.
4140usage: (format STRING &rest OBJECTS) */) 4140usage: (format STRING &rest OBJECTS) */)
4141 (ptrdiff_t nargs, Lisp_Object *args) 4141 (ptrdiff_t nargs, Lisp_Object *args)
4142{ 4142{
4143 return styled_format (nargs, args, false); 4143 return styled_format (nargs, args, false, true);
4144} 4144}
4145 4145
4146DEFUN ("format-message", Fformat_message, Sformat_message, 1, MANY, 0, 4146DEFUN ("format-message", Fformat_message, Sformat_message, 1, MANY, 0,
@@ -4156,13 +4156,16 @@ and right quote replacement characters are specified by
4156usage: (format-message STRING &rest OBJECTS) */) 4156usage: (format-message STRING &rest OBJECTS) */)
4157 (ptrdiff_t nargs, Lisp_Object *args) 4157 (ptrdiff_t nargs, Lisp_Object *args)
4158{ 4158{
4159 return styled_format (nargs, args, true); 4159 return styled_format (nargs, args, true, true);
4160} 4160}
4161 4161
4162/* Implement ‘format-message’ if MESSAGE is true, ‘format’ otherwise. */ 4162/* Implement ‘format-message’ if MESSAGE is true, ‘format’ otherwise.
4163 If NEW_RESULT, the result is a new string; otherwise, the result
4164 may be one of the arguments. */
4163 4165
4164static Lisp_Object 4166Lisp_Object
4165styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) 4167styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message,
4168 bool new_result)
4166{ 4169{
4167 ptrdiff_t n; /* The number of the next arg to substitute. */ 4170 ptrdiff_t n; /* The number of the next arg to substitute. */
4168 char initial_buffer[4000]; 4171 char initial_buffer[4000];
@@ -4192,6 +4195,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4192 /* The start and end bytepos in the output string. */ 4195 /* The start and end bytepos in the output string. */
4193 ptrdiff_t start, end; 4196 ptrdiff_t start, end;
4194 4197
4198 /* Whether the argument is a newly created string. */
4199 bool_bf new_string : 1;
4200
4195 /* Whether the argument is a string with intervals. */ 4201 /* Whether the argument is a string with intervals. */
4196 bool_bf intervals : 1; 4202 bool_bf intervals : 1;
4197 } *info; 4203 } *info;
@@ -4341,7 +4347,10 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4341 memset (&discarded[format0 - format_start], 1, 4347 memset (&discarded[format0 - format_start], 1,
4342 format - format0 - (conversion == '%')); 4348 format - format0 - (conversion == '%'));
4343 if (conversion == '%') 4349 if (conversion == '%')
4344 goto copy_char; 4350 {
4351 new_result = true;
4352 goto copy_char;
4353 }
4345 4354
4346 ++n; 4355 ++n;
4347 if (! (n < nargs)) 4356 if (! (n < nargs))
@@ -4351,6 +4360,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4351 if (nspec < ispec) 4360 if (nspec < ispec)
4352 { 4361 {
4353 spec->argument = args[n]; 4362 spec->argument = args[n];
4363 spec->new_string = false;
4354 spec->intervals = false; 4364 spec->intervals = false;
4355 nspec = ispec; 4365 nspec = ispec;
4356 } 4366 }
@@ -4368,6 +4378,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4368 { 4378 {
4369 Lisp_Object noescape = conversion == 'S' ? Qnil : Qt; 4379 Lisp_Object noescape = conversion == 'S' ? Qnil : Qt;
4370 spec->argument = arg = Fprin1_to_string (arg, noescape); 4380 spec->argument = arg = Fprin1_to_string (arg, noescape);
4381 spec->new_string = true;
4371 if (STRING_MULTIBYTE (arg) && ! multibyte) 4382 if (STRING_MULTIBYTE (arg) && ! multibyte)
4372 { 4383 {
4373 multibyte = true; 4384 multibyte = true;
@@ -4386,6 +4397,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4386 goto retry; 4397 goto retry;
4387 } 4398 }
4388 spec->argument = arg = Fchar_to_string (arg); 4399 spec->argument = arg = Fchar_to_string (arg);
4400 spec->new_string = true;
4389 } 4401 }
4390 4402
4391 if (!EQ (arg, args[n])) 4403 if (!EQ (arg, args[n]))
@@ -4408,6 +4420,11 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4408 4420
4409 if (conversion == 's') 4421 if (conversion == 's')
4410 { 4422 {
4423 if (format == end && format - format_start == 2
4424 && (!new_result || spec->new_string)
4425 && ! string_intervals (args[0]))
4426 return arg;
4427
4411 /* handle case (precision[n] >= 0) */ 4428 /* handle case (precision[n] >= 0) */
4412 4429
4413 ptrdiff_t prec = -1; 4430 ptrdiff_t prec = -1;
@@ -4486,6 +4503,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4486 if (string_intervals (arg)) 4503 if (string_intervals (arg))
4487 spec->intervals = arg_intervals = true; 4504 spec->intervals = arg_intervals = true;
4488 4505
4506 new_result = true;
4489 continue; 4507 continue;
4490 } 4508 }
4491 } 4509 }
@@ -4753,6 +4771,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4753 } 4771 }
4754 spec->end = nchars; 4772 spec->end = nchars;
4755 4773
4774 new_result = true;
4756 continue; 4775 continue;
4757 } 4776 }
4758 } 4777 }
@@ -4771,9 +4790,13 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4771 } 4790 }
4772 convsrc = format_char == '`' ? uLSQM : uRSQM; 4791 convsrc = format_char == '`' ? uLSQM : uRSQM;
4773 convbytes = 3; 4792 convbytes = 3;
4793 new_result = true;
4774 } 4794 }
4775 else if (format_char == '`' && quoting_style == STRAIGHT_QUOTING_STYLE) 4795 else if (format_char == '`' && quoting_style == STRAIGHT_QUOTING_STYLE)
4776 convsrc = "'"; 4796 {
4797 convsrc = "'";
4798 new_result = true;
4799 }
4777 else 4800 else
4778 { 4801 {
4779 /* Copy a single character from format to buf. */ 4802 /* Copy a single character from format to buf. */
@@ -4797,6 +4820,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4797 int c = BYTE8_TO_CHAR (format_char); 4820 int c = BYTE8_TO_CHAR (format_char);
4798 convbytes = CHAR_STRING (c, str); 4821 convbytes = CHAR_STRING (c, str);
4799 convsrc = (char *) str; 4822 convsrc = (char *) str;
4823 new_result = true;
4800 } 4824 }
4801 } 4825 }
4802 4826
@@ -4843,6 +4867,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
4843 if (bufsize < p - buf) 4867 if (bufsize < p - buf)
4844 emacs_abort (); 4868 emacs_abort ();
4845 4869
4870 if (! new_result)
4871 return args[0];
4872
4846 if (maybe_combine_byte) 4873 if (maybe_combine_byte)
4847 nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf); 4874 nchars = multibyte_chars_in_text ((unsigned char *) buf, p - buf);
4848 Lisp_Object val = make_specified_string (buf, nchars, p - buf, multibyte); 4875 Lisp_Object val = make_specified_string (buf, nchars, p - buf, multibyte);
diff --git a/src/emacs.c b/src/emacs.c
index 1ad8af70a74..0fe7d9113b4 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -252,7 +252,7 @@ Initialization options:\n\
252 "\ 252 "\
253Action options:\n\ 253Action options:\n\
254\n\ 254\n\
255FILE visit FILE using find-file\n\ 255FILE visit FILE\n\
256+LINE go to line LINE in next FILE\n\ 256+LINE go to line LINE in next FILE\n\
257+LINE:COLUMN go to line LINE, column COLUMN, in next FILE\n\ 257+LINE:COLUMN go to line LINE, column COLUMN, in next FILE\n\
258--directory, -L DIR prepend DIR to load-path (with :DIR, append DIR)\n\ 258--directory, -L DIR prepend DIR to load-path (with :DIR, append DIR)\n\
@@ -260,13 +260,13 @@ FILE visit FILE using find-file\n\
260--execute EXPR evaluate Emacs Lisp expression EXPR\n\ 260--execute EXPR evaluate Emacs Lisp expression EXPR\n\
261", 261",
262 "\ 262 "\
263--file FILE visit FILE using find-file\n\ 263--file FILE visit FILE\n\
264--find-file FILE visit FILE using find-file\n\ 264--find-file FILE visit FILE\n\
265--funcall, -f FUNC call Emacs Lisp function FUNC with no arguments\n\ 265--funcall, -f FUNC call Emacs Lisp function FUNC with no arguments\n\
266--insert FILE insert contents of FILE into current buffer\n\ 266--insert FILE insert contents of FILE into current buffer\n\
267--kill exit without asking for confirmation\n\ 267--kill exit without asking for confirmation\n\
268--load, -l FILE load Emacs Lisp FILE using the load function\n\ 268--load, -l FILE load Emacs Lisp FILE using the load function\n\
269--visit FILE visit FILE using find-file\n\ 269--visit FILE visit FILE\n\
270\n\ 270\n\
271", 271",
272 "\ 272 "\
diff --git a/src/eval.c b/src/eval.c
index 62e219631db..39d78364d5f 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1428,7 +1428,7 @@ push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype)
1428struct handler * 1428struct handler *
1429push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype) 1429push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype)
1430{ 1430{
1431 struct handler *c = handlerlist->nextfree; 1431 struct handler *CACHEABLE c = handlerlist->nextfree;
1432 if (!c) 1432 if (!c)
1433 { 1433 {
1434 c = malloc (sizeof *c); 1434 c = malloc (sizeof *c);
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 0203a5d5c1a..0da70399193 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -1217,7 +1217,10 @@ xg_create_frame_widgets (struct frame *f)
1217 with regular X drawing primitives, so from a GTK/GDK point of 1217 with regular X drawing primitives, so from a GTK/GDK point of
1218 view, the widget is totally blank. When an expose comes, this 1218 view, the widget is totally blank. When an expose comes, this
1219 will make the widget blank, and then Emacs redraws it. This flickers 1219 will make the widget blank, and then Emacs redraws it. This flickers
1220 a lot, so we turn off double buffering. */ 1220 a lot, so we turn off double buffering.
1221 FIXME: gtk_widget_set_double_buffered is deprecated and might stop
1222 working in the future. We need to migrate away from combining
1223 X and GTK+ drawing to a pure GTK+ build. */
1221 gtk_widget_set_double_buffered (wfixed, FALSE); 1224 gtk_widget_set_double_buffered (wfixed, FALSE);
1222 1225
1223 gtk_window_set_wmclass (GTK_WINDOW (wtop), 1226 gtk_window_set_wmclass (GTK_WINDOW (wtop),
diff --git a/src/keyboard.c b/src/keyboard.c
index 4db50be855c..e8701b88708 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -5925,7 +5925,10 @@ make_lispy_event (struct input_event *event)
5925 ASIZE (wheel_syms)); 5925 ASIZE (wheel_syms));
5926 } 5926 }
5927 5927
5928 if (event->modifiers & (double_modifier | triple_modifier)) 5928 if (NUMBERP (event->arg))
5929 return list4 (head, position, make_number (double_click_count),
5930 event->arg);
5931 else if (event->modifiers & (double_modifier | triple_modifier))
5929 return list3 (head, position, make_number (double_click_count)); 5932 return list3 (head, position, make_number (double_click_count));
5930 else 5933 else
5931 return list2 (head, position); 5934 return list2 (head, position);
diff --git a/src/lcms.c b/src/lcms.c
index cdfbc0ecf99..a5e527911ef 100644
--- a/src/lcms.c
+++ b/src/lcms.c
@@ -102,7 +102,7 @@ DEFUN ("lcms-cie-de2000", Flcms_cie_de2000, Slcms_cie_de2000, 2, 5, 0,
102Each color is a list of L*a*b* coordinates, where the L* channel ranges from 102Each color is a list of L*a*b* coordinates, where the L* channel ranges from
1030 to 100, and the a* and b* channels range from -128 to 128. 1030 to 100, and the a* and b* channels range from -128 to 128.
104Optional arguments KL, KC, KH are weighting parameters for lightness, 104Optional arguments KL, KC, KH are weighting parameters for lightness,
105chroma, and hue, respectively. The parameters each default to 1. */) 105chroma, and hue, respectively. The parameters each default to 1. */)
106 (Lisp_Object color1, Lisp_Object color2, 106 (Lisp_Object color1, Lisp_Object color2,
107 Lisp_Object kL, Lisp_Object kC, Lisp_Object kH) 107 Lisp_Object kL, Lisp_Object kC, Lisp_Object kH)
108{ 108{
@@ -139,6 +139,26 @@ chroma, and hue, respectively. The parameters each default to 1. */)
139 return make_float (cmsCIE2000DeltaE (&Lab1, &Lab2, Kl, Kc, Kh)); 139 return make_float (cmsCIE2000DeltaE (&Lab1, &Lab2, Kl, Kc, Kh));
140} 140}
141 141
142static double
143deg2rad (double degrees)
144{
145 return M_PI * degrees / 180.0;
146}
147
148static cmsCIEXYZ illuminant_d65 = { .X = 95.0455, .Y = 100.0, .Z = 108.8753 };
149
150static void
151default_viewing_conditions (const cmsCIEXYZ *wp, cmsViewingConditions *vc)
152{
153 vc->whitePoint.X = wp->X;
154 vc->whitePoint.Y = wp->Y;
155 vc->whitePoint.Z = wp->Z;
156 vc->Yb = 20;
157 vc->La = 100;
158 vc->surround = AVG_SURROUND;
159 vc->D_value = 1.0;
160}
161
142/* FIXME: code duplication */ 162/* FIXME: code duplication */
143 163
144static bool 164static bool
@@ -160,11 +180,62 @@ parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color)
160 return true; 180 return true;
161} 181}
162 182
163DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 3, 0, 183static bool
184parse_viewing_conditions (Lisp_Object view, const cmsCIEXYZ *wp,
185 cmsViewingConditions *vc)
186{
187#define PARSE_VIEW_CONDITION_FLOAT(field) \
188 if (CONSP (view) && NUMBERP (XCAR (view))) \
189 { \
190 vc->field = XFLOATINT (XCAR (view)); \
191 view = XCDR (view); \
192 } \
193 else \
194 return false;
195#define PARSE_VIEW_CONDITION_INT(field) \
196 if (CONSP (view) && NATNUMP (XCAR (view))) \
197 { \
198 CHECK_RANGED_INTEGER (XCAR (view), 1, 4); \
199 vc->field = XINT (XCAR (view)); \
200 view = XCDR (view); \
201 } \
202 else \
203 return false;
204
205 PARSE_VIEW_CONDITION_FLOAT (Yb);
206 PARSE_VIEW_CONDITION_FLOAT (La);
207 PARSE_VIEW_CONDITION_INT (surround);
208 PARSE_VIEW_CONDITION_FLOAT (D_value);
209
210 if (! NILP (view))
211 return false;
212
213 vc->whitePoint.X = wp->X;
214 vc->whitePoint.Y = wp->Y;
215 vc->whitePoint.Z = wp->Z;
216 return true;
217}
218
219/* References:
220 Li, Luo et al. "The CRI-CAM02UCS colour rendering index." COLOR research
221 and application, 37 No.3, 2012.
222 Luo et al. "Uniform colour spaces based on CIECAM02 colour appearance
223 model." COLOR research and application, 31 No.4, 2006. */
224
225DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 4, 0,
164 doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2. 226 doc: /* Compute CAM02-UCS metric distance between COLOR1 and COLOR2.
165Each color is a list of XYZ coordinates, with Y scaled about unity. 227Each color is a list of XYZ tristimulus values, with Y scaled about unity.
166Optional argument is the XYZ white point, which defaults to illuminant D65. */) 228Optional argument WHITEPOINT is the XYZ white point, which defaults to
167 (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint) 229illuminant D65.
230Optional argument VIEW is a list containing the viewing conditions, and
231is of the form (YB LA SURROUND DVALUE) where SURROUND corresponds to
232 1 AVG_SURROUND
233 2 DIM_SURROUND
234 3 DARK_SURROUND
235 4 CUTSHEET_SURROUND
236The default viewing conditions are (20 100 1 1). */)
237 (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint,
238 Lisp_Object view)
168{ 239{
169 cmsViewingConditions vc; 240 cmsViewingConditions vc;
170 cmsJCh jch1, jch2; 241 cmsJCh jch1, jch2;
@@ -188,17 +259,13 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */)
188 if (!(CONSP (color2) && parse_xyz_list (color2, &xyz2))) 259 if (!(CONSP (color2) && parse_xyz_list (color2, &xyz2)))
189 signal_error ("Invalid color", color2); 260 signal_error ("Invalid color", color2);
190 if (NILP (whitepoint)) 261 if (NILP (whitepoint))
191 parse_xyz_list (Vlcms_d65_xyz, &xyzw); 262 xyzw = illuminant_d65;
192 else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw))) 263 else if (!(CONSP (whitepoint) && parse_xyz_list (whitepoint, &xyzw)))
193 signal_error ("Invalid white point", whitepoint); 264 signal_error ("Invalid white point", whitepoint);
194 265 if (NILP (view))
195 vc.whitePoint.X = xyzw.X; 266 default_viewing_conditions (&xyzw, &vc);
196 vc.whitePoint.Y = xyzw.Y; 267 else if (!(CONSP (view) && parse_viewing_conditions (view, &xyzw, &vc)))
197 vc.whitePoint.Z = xyzw.Z; 268 signal_error ("Invalid view conditions", view);
198 vc.Yb = 20;
199 vc.La = 100;
200 vc.surround = AVG_SURROUND;
201 vc.D_value = 1.0;
202 269
203 h1 = cmsCIECAM02Init (0, &vc); 270 h1 = cmsCIECAM02Init (0, &vc);
204 h2 = cmsCIECAM02Init (0, &vc); 271 h2 = cmsCIECAM02Init (0, &vc);
@@ -227,10 +294,10 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */)
227 Mp2 = 43.86 * log (1.0 + 0.0228 * (jch2.C * sqrt (sqrt (FL)))); 294 Mp2 = 43.86 * log (1.0 + 0.0228 * (jch2.C * sqrt (sqrt (FL))));
228 Jp1 = 1.7 * jch1.J / (1.0 + (0.007 * jch1.J)); 295 Jp1 = 1.7 * jch1.J / (1.0 + (0.007 * jch1.J));
229 Jp2 = 1.7 * jch2.J / (1.0 + (0.007 * jch2.J)); 296 Jp2 = 1.7 * jch2.J / (1.0 + (0.007 * jch2.J));
230 ap1 = Mp1 * cos (jch1.h); 297 ap1 = Mp1 * cos (deg2rad (jch1.h));
231 ap2 = Mp2 * cos (jch2.h); 298 ap2 = Mp2 * cos (deg2rad (jch2.h));
232 bp1 = Mp1 * sin (jch1.h); 299 bp1 = Mp1 * sin (deg2rad (jch1.h));
233 bp2 = Mp2 * sin (jch2.h); 300 bp2 = Mp2 * sin (deg2rad (jch2.h));
234 301
235 return make_float (sqrt ((Jp2 - Jp1) * (Jp2 - Jp1) + 302 return make_float (sqrt ((Jp2 - Jp1) * (Jp2 - Jp1) +
236 (ap2 - ap1) * (ap2 - ap1) + 303 (ap2 - ap1) * (ap2 - ap1) +
@@ -239,7 +306,7 @@ Optional argument is the XYZ white point, which defaults to illuminant D65. */)
239 306
240DEFUN ("lcms-temp->white-point", Flcms_temp_to_white_point, Slcms_temp_to_white_point, 1, 1, 0, 307DEFUN ("lcms-temp->white-point", Flcms_temp_to_white_point, Slcms_temp_to_white_point, 1, 1, 0,
241 doc: /* Return XYZ black body chromaticity from TEMPERATURE given in K. 308 doc: /* Return XYZ black body chromaticity from TEMPERATURE given in K.
242Valid range of TEMPERATURE is from 4000K to 25000K. */) 309Valid range of TEMPERATURE is from 4000K to 25000K. */)
243 (Lisp_Object temperature) 310 (Lisp_Object temperature)
244{ 311{
245 cmsFloat64Number tempK; 312 cmsFloat64Number tempK;
@@ -291,12 +358,6 @@ DEFUN ("lcms2-available-p", Flcms2_available_p, Slcms2_available_p, 0, 0, 0,
291void 358void
292syms_of_lcms2 (void) 359syms_of_lcms2 (void)
293{ 360{
294 DEFVAR_LISP ("lcms-d65-xyz", Vlcms_d65_xyz,
295 doc: /* D65 illuminant as a CIE XYZ triple. */);
296 Vlcms_d65_xyz = list3 (make_float (0.950455),
297 make_float (1.0),
298 make_float (1.088753));
299
300 defsubr (&Slcms_cie_de2000); 361 defsubr (&Slcms_cie_de2000);
301 defsubr (&Slcms_cam02_ucs); 362 defsubr (&Slcms_cam02_ucs);
302 defsubr (&Slcms2_available_p); 363 defsubr (&Slcms2_available_p);
diff --git a/src/lisp.h b/src/lisp.h
index c5030824427..0c3ca3ae06b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3969,6 +3969,7 @@ extern _Noreturn void time_overflow (void);
3969extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); 3969extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool);
3970extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, 3970extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t,
3971 ptrdiff_t, bool); 3971 ptrdiff_t, bool);
3972extern Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool, bool);
3972extern void init_editfns (bool); 3973extern void init_editfns (bool);
3973extern void syms_of_editfns (void); 3974extern void syms_of_editfns (void);
3974 3975
diff --git a/src/nsterm.m b/src/nsterm.m
index 27515335332..f0b6a70dae3 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -1820,8 +1820,8 @@ x_set_window_size (struct frame *f,
1820 1820
1821 if (pixelwise) 1821 if (pixelwise)
1822 { 1822 {
1823 pixelwidth = width; 1823 pixelwidth = FRAME_TEXT_TO_PIXEL_WIDTH (f, width);
1824 pixelheight = height; 1824 pixelheight = FRAME_TEXT_TO_PIXEL_HEIGHT (f, height);
1825 } 1825 }
1826 else 1826 else
1827 { 1827 {
@@ -6498,24 +6498,139 @@ not_in_argv (NSString *arg)
6498 6498
6499 if ([theEvent type] == NSEventTypeScrollWheel) 6499 if ([theEvent type] == NSEventTypeScrollWheel)
6500 { 6500 {
6501 CGFloat delta = [theEvent deltaY]; 6501#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070
6502 /* Mac notebooks send wheel events w/delta =0 when trackpad scrolling */ 6502#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
6503 if (delta == 0) 6503 if ([theEvent respondsToSelector:@selector(hasPreciseScrollingDeltas)])
6504 { 6504 {
6505 delta = [theEvent deltaX]; 6505#endif
6506 if (delta == 0) 6506 /* If the input device is a touchpad or similar, use precise
6507 * scrolling deltas. These are measured in pixels, so we
6508 * have to add them up until they exceed one line height,
6509 * then we can send a scroll wheel event.
6510 *
6511 * If the device only has coarse scrolling deltas, like a
6512 * real mousewheel, the deltas represent a ratio of whole
6513 * lines, so round up the number of lines. This means we
6514 * always send one scroll event per click, but can still
6515 * scroll more than one line if the OS tells us to.
6516 */
6517 bool horizontal;
6518 int lines = 0;
6519 int scrollUp = NO;
6520
6521 /* FIXME: At the top or bottom of the buffer we should
6522 * ignore momentum-phase events. */
6523 if (! ns_use_mwheel_momentum
6524 && [theEvent momentumPhase] != NSEventPhaseNone)
6525 return;
6526
6527 if ([theEvent hasPreciseScrollingDeltas])
6507 { 6528 {
6508 NSTRACE_MSG ("deltaIsZero"); 6529 static int totalDeltaX, totalDeltaY;
6509 return; 6530 int lineHeight;
6531
6532 if (NUMBERP (ns_mwheel_line_height))
6533 lineHeight = XINT (ns_mwheel_line_height);
6534 else
6535 {
6536 /* FIXME: Use actual line height instead of the default. */
6537 lineHeight = default_line_pixel_height
6538 (XWINDOW (FRAME_SELECTED_WINDOW (emacsframe)));
6539 }
6540
6541 if ([theEvent phase] == NSEventPhaseBegan)
6542 {
6543 totalDeltaX = 0;
6544 totalDeltaY = 0;
6545 }
6546
6547 totalDeltaX += [theEvent scrollingDeltaX];
6548 totalDeltaY += [theEvent scrollingDeltaY];
6549
6550 /* Calculate the number of lines, if any, to scroll, and
6551 * reset the total delta for the direction we're NOT
6552 * scrolling so that small movements don't add up. */
6553 if (abs (totalDeltaX) > abs (totalDeltaY)
6554 && abs (totalDeltaX) > lineHeight)
6555 {
6556 horizontal = YES;
6557 scrollUp = totalDeltaX > 0;
6558
6559 lines = abs (totalDeltaX / lineHeight);
6560 totalDeltaX = totalDeltaX % lineHeight;
6561 totalDeltaY = 0;
6562 }
6563 else if (abs (totalDeltaY) >= abs (totalDeltaX)
6564 && abs (totalDeltaY) > lineHeight)
6565 {
6566 horizontal = NO;
6567 scrollUp = totalDeltaY > 0;
6568
6569 lines = abs (totalDeltaY / lineHeight);
6570 totalDeltaY = totalDeltaY % lineHeight;
6571 totalDeltaX = 0;
6572 }
6573
6574 if (lines > 1 && ! ns_use_mwheel_acceleration)
6575 lines = 1;
6510 } 6576 }
6511 emacs_event->kind = HORIZ_WHEEL_EVENT; 6577 else
6578 {
6579 CGFloat delta;
6580
6581 if ([theEvent scrollingDeltaY] == 0)
6582 {
6583 horizontal = YES;
6584 delta = [theEvent scrollingDeltaX];
6585 }
6586 else
6587 {
6588 horizontal = NO;
6589 delta = [theEvent scrollingDeltaY];
6590 }
6591
6592 lines = (ns_use_mwheel_acceleration)
6593 ? ceil (fabs (delta)) : 1;
6594
6595 scrollUp = delta > 0;
6596 }
6597
6598 if (lines == 0)
6599 return;
6600
6601 emacs_event->kind = horizontal ? HORIZ_WHEEL_EVENT : WHEEL_EVENT;
6602 emacs_event->arg = (make_number (lines));
6603
6604 emacs_event->code = 0;
6605 emacs_event->modifiers = EV_MODIFIERS (theEvent) |
6606 (scrollUp ? up_modifier : down_modifier);
6607#if MAC_OS_X_VERSION_MIN_REQUIRED < 1070
6512 } 6608 }
6513 else 6609 else
6514 emacs_event->kind = WHEEL_EVENT; 6610#endif
6611#endif /* defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED >= 1070 */
6612#if defined (NS_IMPL_GNUSTEP) || MAC_OS_X_VERSION_MIN_REQUIRED < 1070
6613 {
6614 CGFloat delta = [theEvent deltaY];
6615 /* Mac notebooks send wheel events w/delta =0 when trackpad scrolling */
6616 if (delta == 0)
6617 {
6618 delta = [theEvent deltaX];
6619 if (delta == 0)
6620 {
6621 NSTRACE_MSG ("deltaIsZero");
6622 return;
6623 }
6624 emacs_event->kind = HORIZ_WHEEL_EVENT;
6625 }
6626 else
6627 emacs_event->kind = WHEEL_EVENT;
6515 6628
6516 emacs_event->code = 0; 6629 emacs_event->code = 0;
6517 emacs_event->modifiers = EV_MODIFIERS (theEvent) | 6630 emacs_event->modifiers = EV_MODIFIERS (theEvent) |
6518 ((delta > 0) ? up_modifier : down_modifier); 6631 ((delta > 0) ? up_modifier : down_modifier);
6632 }
6633#endif
6519 } 6634 }
6520 else 6635 else
6521 { 6636 {
@@ -6524,9 +6639,11 @@ not_in_argv (NSString *arg)
6524 emacs_event->modifiers = EV_MODIFIERS (theEvent) 6639 emacs_event->modifiers = EV_MODIFIERS (theEvent)
6525 | EV_UDMODIFIERS (theEvent); 6640 | EV_UDMODIFIERS (theEvent);
6526 } 6641 }
6642
6527 XSETINT (emacs_event->x, lrint (p.x)); 6643 XSETINT (emacs_event->x, lrint (p.x));
6528 XSETINT (emacs_event->y, lrint (p.y)); 6644 XSETINT (emacs_event->y, lrint (p.y));
6529 EV_TRAILER (theEvent); 6645 EV_TRAILER (theEvent);
6646 return;
6530} 6647}
6531 6648
6532 6649
@@ -6707,9 +6824,10 @@ not_in_argv (NSString *arg)
6707 6824
6708 if (wait_for_tool_bar) 6825 if (wait_for_tool_bar)
6709 { 6826 {
6710 /* The toolbar height is always 0 in fullscreen, so don't wait 6827 /* The toolbar height is always 0 in fullscreen and undecorated
6711 for it to become available. */ 6828 frames, so don't wait for it to become available. */
6712 if (FRAME_TOOLBAR_HEIGHT (emacsframe) == 0 6829 if (FRAME_TOOLBAR_HEIGHT (emacsframe) == 0
6830 && FRAME_UNDECORATED (emacsframe) == false
6713 && ! [self isFullscreen]) 6831 && ! [self isFullscreen])
6714 { 6832 {
6715 NSTRACE_MSG ("Waiting for toolbar"); 6833 NSTRACE_MSG ("Waiting for toolbar");
@@ -7090,9 +7208,9 @@ not_in_argv (NSString *arg)
7090 7208
7091 win = [[EmacsWindow alloc] 7209 win = [[EmacsWindow alloc]
7092 initWithContentRect: r 7210 initWithContentRect: r
7093 styleMask: (FRAME_UNDECORATED (f) 7211 styleMask: ((FRAME_UNDECORATED (f)
7094 ? FRAME_UNDECORATED_FLAGS 7212 ? FRAME_UNDECORATED_FLAGS
7095 : FRAME_DECORATED_FLAGS 7213 : FRAME_DECORATED_FLAGS)
7096#ifdef NS_IMPL_COCOA 7214#ifdef NS_IMPL_COCOA
7097 | NSWindowStyleMaskResizable 7215 | NSWindowStyleMaskResizable
7098 | NSWindowStyleMaskMiniaturizable 7216 | NSWindowStyleMaskMiniaturizable
@@ -9166,6 +9284,23 @@ Note that this does not apply to images.
9166This variable is ignored on Mac OS X < 10.7 and GNUstep. */); 9284This variable is ignored on Mac OS X < 10.7 and GNUstep. */);
9167 ns_use_srgb_colorspace = YES; 9285 ns_use_srgb_colorspace = YES;
9168 9286
9287 DEFVAR_BOOL ("ns-use-mwheel-acceleration",
9288 ns_use_mwheel_acceleration,
9289 doc: /*Non-nil means use macOS's standard mouse wheel acceleration.
9290This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */);
9291 ns_use_mwheel_acceleration = YES;
9292
9293 DEFVAR_LISP ("ns-mwheel-line-height", ns_mwheel_line_height,
9294 doc: /*The number of pixels touchpad scrolling considers one line.
9295Nil or a non-number means use the default frame line height.
9296This variable is ignored on macOS < 10.7 and GNUstep. Default is nil. */);
9297 ns_mwheel_line_height = Qnil;
9298
9299 DEFVAR_BOOL ("ns-use-mwheel-momentum", ns_use_mwheel_momentum,
9300 doc: /*Non-nil means mouse wheel scrolling uses momentum.
9301This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */);
9302 ns_use_mwheel_momentum = YES;
9303
9169 /* TODO: move to common code */ 9304 /* TODO: move to common code */
9170 DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars, 9305 DEFVAR_LISP ("x-toolkit-scroll-bars", Vx_toolkit_scroll_bars,
9171 doc: /* Which toolkit scroll bars Emacs uses, if any. 9306 doc: /* Which toolkit scroll bars Emacs uses, if any.
diff --git a/src/term.c b/src/term.c
index a2ae8c2c6f0..065bce45d3c 100644
--- a/src/term.c
+++ b/src/term.c
@@ -155,12 +155,16 @@ tty_ring_bell (struct frame *f)
155static void 155static void
156tty_send_additional_strings (struct terminal *terminal, Lisp_Object sym) 156tty_send_additional_strings (struct terminal *terminal, Lisp_Object sym)
157{ 157{
158 Lisp_Object lisp_terminal; 158 /* Use only accessors like CDR_SAFE and assq_no_quit to avoid any
159 Lisp_Object extra_codes; 159 form of quitting or signaling an error, since this function can
160 run as part of the "emergency escape" procedure invoked in the
161 middle of GC, where quitting means crashing (Bug#17406). */
162 if (! terminal->name)
163 return;
160 struct tty_display_info *tty = terminal->display_info.tty; 164 struct tty_display_info *tty = terminal->display_info.tty;
161 165
162 XSETTERMINAL (lisp_terminal, terminal); 166 for (Lisp_Object extra_codes
163 for (extra_codes = Fterminal_parameter (lisp_terminal, sym); 167 = CDR_SAFE (assq_no_quit (sym, terminal->param_alist));
164 CONSP (extra_codes); 168 CONSP (extra_codes);
165 extra_codes = XCDR (extra_codes)) 169 extra_codes = XCDR (extra_codes))
166 { 170 {
diff --git a/src/termhooks.h b/src/termhooks.h
index 97c128ba4e2..b5171bf1229 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -116,7 +116,9 @@ enum event_kind
116 .frame_or_window gives the frame 116 .frame_or_window gives the frame
117 the wheel event occurred in. 117 the wheel event occurred in.
118 .timestamp gives a timestamp (in 118 .timestamp gives a timestamp (in
119 milliseconds) for the event. */ 119 milliseconds) for the event.
120 .arg may contain the number of
121 lines to scroll. */
120 HORIZ_WHEEL_EVENT, /* A wheel event generated by a second 122 HORIZ_WHEEL_EVENT, /* A wheel event generated by a second
121 horizontal wheel that is present on some 123 horizontal wheel that is present on some
122 mice. See WHEEL_EVENT. */ 124 mice. See WHEEL_EVENT. */
diff --git a/src/w32term.c b/src/w32term.c
index a7a510b9ecb..d7ec40118f3 100644
--- a/src/w32term.c
+++ b/src/w32term.c
@@ -6252,7 +6252,8 @@ w32fullscreen_hook (struct frame *f)
6252 6252
6253 if (FRAME_PREV_FSMODE (f) == FULLSCREEN_BOTH) 6253 if (FRAME_PREV_FSMODE (f) == FULLSCREEN_BOTH)
6254 { 6254 {
6255 SetWindowLong (hwnd, GWL_STYLE, dwStyle | WS_OVERLAPPEDWINDOW); 6255 if (!FRAME_UNDECORATED (f))
6256 SetWindowLong (hwnd, GWL_STYLE, dwStyle | WS_OVERLAPPEDWINDOW);
6256 SetWindowPlacement (hwnd, &FRAME_NORMAL_PLACEMENT (f)); 6257 SetWindowPlacement (hwnd, &FRAME_NORMAL_PLACEMENT (f));
6257 } 6258 }
6258 else if (FRAME_PREV_FSMODE (f) == FULLSCREEN_HEIGHT 6259 else if (FRAME_PREV_FSMODE (f) == FULLSCREEN_HEIGHT
@@ -6278,7 +6279,8 @@ w32fullscreen_hook (struct frame *f)
6278 6279
6279 w32_fullscreen_rect (hwnd, f->want_fullscreen, 6280 w32_fullscreen_rect (hwnd, f->want_fullscreen,
6280 FRAME_NORMAL_PLACEMENT (f).rcNormalPosition, &rect); 6281 FRAME_NORMAL_PLACEMENT (f).rcNormalPosition, &rect);
6281 SetWindowLong (hwnd, GWL_STYLE, dwStyle & ~WS_OVERLAPPEDWINDOW); 6282 if (!FRAME_UNDECORATED (f))
6283 SetWindowLong (hwnd, GWL_STYLE, dwStyle & ~WS_OVERLAPPEDWINDOW);
6282 SetWindowPos (hwnd, HWND_TOP, rect.left, rect.top, 6284 SetWindowPos (hwnd, HWND_TOP, rect.left, rect.top,
6283 rect.right - rect.left, rect.bottom - rect.top, 6285 rect.right - rect.left, rect.bottom - rect.top,
6284 SWP_NOOWNERZORDER | SWP_FRAMECHANGED); 6286 SWP_NOOWNERZORDER | SWP_FRAMECHANGED);
diff --git a/src/xdisp.c b/src/xdisp.c
index dc5dbb05762..86164eb9f6f 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -10194,7 +10194,7 @@ vadd_to_log (char const *format, va_list ap)
10194 for (ptrdiff_t i = 1; i <= nargs; i++) 10194 for (ptrdiff_t i = 1; i <= nargs; i++)
10195 args[i] = va_arg (ap, Lisp_Object); 10195 args[i] = va_arg (ap, Lisp_Object);
10196 Lisp_Object msg = Qnil; 10196 Lisp_Object msg = Qnil;
10197 msg = Fformat_message (nargs, args); 10197 msg = styled_format (nargs, args, true, false);
10198 10198
10199 ptrdiff_t len = SBYTES (msg) + 1; 10199 ptrdiff_t len = SBYTES (msg) + 1;
10200 USE_SAFE_ALLOCA; 10200 USE_SAFE_ALLOCA;
@@ -19525,7 +19525,7 @@ DEFUN ("trace-to-stderr", Ftrace_to_stderr, Strace_to_stderr, 1, MANY, "",
19525usage: (trace-to-stderr STRING &rest OBJECTS) */) 19525usage: (trace-to-stderr STRING &rest OBJECTS) */)
19526 (ptrdiff_t nargs, Lisp_Object *args) 19526 (ptrdiff_t nargs, Lisp_Object *args)
19527{ 19527{
19528 Lisp_Object s = Fformat (nargs, args); 19528 Lisp_Object s = styled_format (nargs, args, false, false);
19529 fwrite (SDATA (s), 1, SBYTES (s), stderr); 19529 fwrite (SDATA (s), 1, SBYTES (s), stderr);
19530 return Qnil; 19530 return Qnil;
19531} 19531}
@@ -22395,8 +22395,8 @@ Value is the new character position of point. */)
22395 row += dir; 22395 row += dir;
22396 else 22396 else
22397 row -= dir; 22397 row -= dir;
22398 if (row < MATRIX_FIRST_TEXT_ROW (w->current_matrix) 22398 if (!(MATRIX_FIRST_TEXT_ROW (w->current_matrix) <= row
22399 || row > MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)) 22399 && row < MATRIX_BOTTOM_TEXT_ROW (w->current_matrix, w)))
22400 goto simulate_display; 22400 goto simulate_display;
22401 22401
22402 if (dir > 0) 22402 if (dir > 0)
diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
new file mode 100644
index 00000000000..f52a2b1896c
--- /dev/null
+++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
@@ -0,0 +1,130 @@
1;;; edebug-test-code.el --- Sample code for the Edebug test suite
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; Author: Gemini Lasswell
6
7;; This file is part of GNU Emacs.
8
9;; This program is free software: you can redistribute it and/or
10;; modify it under the terms of the GNU General Public License as
11;; published by the Free Software Foundation, either version 3 of the
12;; License, or (at your option) any later version.
13;;
14;; This program is distributed in the hope that it will be useful, but
15;; WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17;; General Public License for more details.
18;;
19;; You should have received a copy of the GNU General Public License
20;; along with this program. If not, see <https://www.gnu.org/licenses/>.
21
22;;; Commentary:
23
24;; This file contains sample code used by edebug-tests.el.
25;; Before evaluation, it will be preprocessed by
26;; `edebug-tests-setup-code-file' which will remove all tags
27;; between !'s and save their positions for use by the tests.
28
29;;; Code:
30
31(defun edebug-test-code-fac (n)
32 !start!(if !step!(< 0 n)
33 (* n (edebug-test-code-fac (1- n)))!mult!
34 1))
35
36(defun edebug-test-code-concat (a b flag)
37 !start!(if flag!flag!
38 !then-start!(concat a!then-a! b!then-b!)!then-concat!
39 !else-start!(concat b!else-b! a!else-a!)!else-concat!)!if!)
40
41(defun edebug-test-code-range (num)
42 !start!(let ((index 0)
43 (result nil))
44 (while (< index num)!test!
45 (push index result)!loop!
46 (cl-incf index))!end-loop!
47 (nreverse result)))
48
49(defun edebug-test-code-choices (input)
50 !start!(cond
51 ((eq input 0) "zero")
52 ((eq input 7) 42)
53 (t !edebug!(edebug))))
54
55(defvar edebug-test-code-total nil)
56
57(defun edebug-test-code-multiply (times value)
58 !start!(setq edebug-test-code-total 0)
59 (cl-dotimes (index times)
60 (setq edebug-test-code-total (+ edebug-test-code-total value))!setq!)
61 edebug-test-code-total)
62
63(defun edebug-test-code-format-vector-node (node)
64 !start!(concat "["
65 (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply!
66 "]"))
67
68(defun edebug-test-code-format-list-node (node)
69 !start!(concat "{"
70 (apply 'concat (mapcar 'edebug-test-code-format-node node))!apply!
71 "}"))
72
73(defun edebug-test-code-format-node (node)
74 !start!(cond
75 (!vectorp!(vectorp node!vnode!)!vtest! !vbefore!(edebug-test-code-format-vector-node node))
76 ((listp node) (edebug-test-code-format-list-node node))
77 (t (format "%s" node))))
78
79(defvar edebug-test-code-flavor "strawberry")
80
81(defmacro edebug-test-code-with-flavor (new-flavor &rest body)
82 (declare (debug (form body))
83 (indent 1))
84 `(let ((edebug-test-code-flavor ,new-flavor))
85 ,@body))
86
87(defun edebug-test-code-try-flavors ()
88 (let* (tried)
89 (push edebug-test-code-flavor tried)
90 !macro!(edebug-test-code-with-flavor "chocolate"
91 (push edebug-test-code-flavor tried))
92 tried)!end!)
93
94(unless (featurep 'edebug-tests-nutty)!nutty!
95 !setq!(setq edebug-test-code-flavor (car (edebug-test-code-try-flavors)))!end-setq!)!end-unless!
96
97(cl-defgeneric edebug-test-code-emphasize (x))
98(cl-defmethod edebug-test-code-emphasize ((x integer))
99 !start!(format "The number is not %s or %s, but %s!"
100 (1+ x) (1- x) x))
101(cl-defmethod edebug-test-code-emphasize ((x string))
102 !start!(format "***%s***" x))
103
104(defun edebug-test-code-use-methods ()
105 (list
106 !number!(edebug-test-code-emphasize 100)
107 !string!(edebug-test-code-emphasize "yes")))
108
109(defun edebug-test-code-make-lambda (n)
110 (lambda (x) (+ x!x! n)))
111
112(defun edebug-test-code-use-lambda ()
113 !start!(mapcar (edebug-test-code-make-lambda 10) '(1 2 3)))
114
115(defun edebug-test-code-circular-read-syntax ()
116 '(#1=a . #1#))
117
118(defun edebug-test-code-hash-read-syntax ()
119 !start!(list #("abcd" 1 3 (face italic))
120 #x01ff))
121
122(defun edebug-test-code-empty-string-list ()
123 !start!(list "")!step!)
124
125(defun edebug-test-code-current-buffer ()
126 !start!(with-current-buffer (get-buffer-create "*edebug-test-code-buffer*")
127 !body!(format "current-buffer: %s" (current-buffer))))
128
129(provide 'edebug-test-code)
130;;; edebug-test-code.el ends here
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el
new file mode 100644
index 00000000000..02f4d1c5abe
--- /dev/null
+++ b/test/lisp/emacs-lisp/edebug-tests.el
@@ -0,0 +1,903 @@
1;;; edebug-tests.el --- Edebug test suite -*- lexical-binding:t -*-
2
3;; Copyright (C) 2017 Free Software Foundation, Inc.
4
5;; Author: Gemini Lasswell
6
7;; This file is part of GNU Emacs.
8
9;; This program is free software: you can redistribute it and/or
10;; modify it under the terms of the GNU General Public License as
11;; published by the Free Software Foundation, either version 3 of the
12;; License, or (at your option) any later version.
13;;
14;; This program is distributed in the hope that it will be useful, but
15;; WITHOUT ANY WARRANTY; without even the implied warranty of
16;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17;; General Public License for more details.
18;;
19;; You should have received a copy of the GNU General Public License
20;; along with this program. If not, see <https://www.gnu.org/licenses/>.
21
22;;; Commentary:
23
24;; These tests focus on Edebug's user interface for setting
25;; breakpoints, stepping through and tracing code, and evaluating
26;; values used by the code. In addition there are some tests of
27;; Edebug's reader. There are large parts of Edebug's functionality
28;; not covered by these tests, including coverage testing, macro
29;; specifications, and the eval list buffer.
30
31;;; Code:
32
33(require 'cl-lib)
34(require 'ert)
35(require 'ert-x)
36(require 'edebug)
37(require 'kmacro)
38
39;; Use `eval-and-compile' because this is used by the macro
40;; `edebug-tests-deftest'.
41(eval-and-compile
42 (defvar edebug-tests-sample-code-file
43 (expand-file-name
44 "edebug-resources/edebug-test-code.el"
45 (file-name-directory (or (bound-and-true-p byte-compile-current-file)
46 load-file-name
47 buffer-file-name)))
48 "Name of file containing code samples for Edebug tests."))
49
50(defvar edebug-tests-temp-file nil
51 "Name of temp file containing sample code stripped of stop point symbols.")
52(defvar edebug-tests-stop-points nil
53 "An alist of alists mapping function symbol -> stop point name -> marker.
54Used by the tests to refer to locations in `edebug-tests-temp-file'.")
55(defvar edebug-tests-messages nil
56 "Messages collected during execution of the current test.")
57
58(defvar edebug-tests-@-result 'no-result
59 "Return value of `edebug-tests-func', or no-result if there isn't one yet.")
60
61(defvar edebug-tests-failure-in-post-command nil
62 "An error trapped in `edebug-tests-post-command'.
63Since `should' failures which happen inside `post-command-hook' will
64be trapped by the command loop, this preserves them until we get
65back to the top level.")
66
67(defvar edebug-tests-keymap
68 (let ((map (make-sparse-keymap)))
69 (define-key map "@" 'edebug-tests-call-instrumented-func)
70 (define-key map "C-u" 'universal-argument)
71 (define-key map "C-p" 'previous-line)
72 (define-key map "C-n" 'next-line)
73 (define-key map "C-b" 'backward-char)
74 (define-key map "C-a" 'move-beginning-of-line)
75 (define-key map "C-e" 'move-end-of-line)
76 (define-key map "C-k" 'kill-line)
77 (define-key map "M-x" 'execute-extended-command)
78 (define-key map "C-M-x" 'eval-defun)
79 (define-key map "C-x X b" 'edebug-set-breakpoint)
80 (define-key map "C-x X w" 'edebug-where)
81 map)
82 "Keys used by the keyboard macros in Edebug's tests.")
83
84;;; Macros for defining tests:
85
86(defmacro edebug-tests-with-default-config (&rest body)
87 "Create a consistent environment for an Edebug test BODY to run in."
88 (declare (debug (body)))
89 `(cl-letf* (
90 ;; These defcustoms are set to their original value.
91 (edebug-setup-hook nil)
92 (edebug-all-defs nil)
93 (edebug-all-forms nil)
94 (edebug-eval-macro-args nil)
95 (edebug-save-windows t)
96 (edebug-save-displayed-buffer-points nil)
97 (edebug-initial-mode 'step)
98 (edebug-trace nil)
99 (edebug-test-coverage nil)
100 (edebug-print-length 50)
101 (edebug-print-level 50)
102 (edebug-print-circle t)
103 (edebug-unwrap-results nil)
104 (edebug-on-error t)
105 (edebug-on-quit t)
106 (edebug-global-break-condition nil)
107 (edebug-sit-for-seconds 1)
108
109 ;; sit-on interferes with keyboard macros.
110 (edebug-sit-on-break nil)
111 (edebug-continue-kbd-macro t))
112 ,@body))
113
114(defmacro edebug-tests-with-normal-env (&rest body)
115 "Set up the environment for an Edebug test BODY, run it, and clean up."
116 (declare (debug (body)))
117 `(edebug-tests-with-default-config
118 (let ((edebug-tests-failure-in-post-command nil)
119 (edebug-tests-temp-file (make-temp-file "edebug-tests-" nil ".el")))
120 (edebug-tests-setup-code-file edebug-tests-temp-file)
121 (ert-with-message-capture
122 edebug-tests-messages
123 (unwind-protect
124 (with-current-buffer (find-file edebug-tests-temp-file)
125 (read-only-mode)
126 (setq lexical-binding t)
127 (eval-buffer)
128 ,@body
129 (when edebug-tests-failure-in-post-command
130 (signal (car edebug-tests-failure-in-post-command)
131 (cdr edebug-tests-failure-in-post-command))))
132 (unload-feature 'edebug-test-code)
133 (with-current-buffer (find-file-noselect edebug-tests-temp-file)
134 (set-buffer-modified-p nil))
135 (ignore-errors (kill-buffer (find-file-noselect
136 edebug-tests-temp-file)))
137 (ignore-errors (delete-file edebug-tests-temp-file)))))))
138
139;; The following macro and its support functions implement an extension
140;; to keyboard macros to allow interleaving of keyboard macro
141;; events with evaluation of Lisp expressions. The Lisp expressions
142;; are called from within `post-command-hook', which is a strategy
143;; inspired by `kmacro-step-edit-macro'.
144
145;; Some of the details necessary to get this to work with Edebug are:
146;; -- ERT's `should' macros raise errors, and errors within
147;; `post-command-hook' are trapped by the command loop. The
148;; workaround is to trap and save an error inside the hook
149;; function and reraise it after the macro exits.
150;; -- `edebug-continue-kbd-macro' must be non-nil.
151;; -- Edebug calls `exit-recursive-edit' which turns off keyboard
152;; macro execution. Solved with an advice wrapper for
153;; `exit-recursive-edit' which preserves the keyboard macro state.
154
155(defmacro edebug-tests-run-kbd-macro (&rest macro)
156 "Run a MACRO consisting of both keystrokes and test assertions.
157MACRO should be a list, where each item is either a keyboard
158macro segment (in string or vector form) or a Lisp expression.
159Convert the macro segments into keyboard macros and execute them.
160After the execution of the last event of each segment, evaluate
161the Lisp expressions following the segment."
162 (let ((prepared (edebug-tests-prepare-macro macro)))
163 `(edebug-tests-run-macro ,@prepared)))
164
165;; Make support functions for edebug-tests-run-kbd-macro
166;; available at compile time.
167(eval-and-compile
168 (defun edebug-tests-prepare-macro (macro)
169 "Prepare a MACRO for execution.
170MACRO should be a list containing strings, vectors, and Lisp
171forms. Convert the strings and vectors to keyboard macros in
172vector representation and concatenate them to make a single
173keyboard macro. Also build a list of the same length as the
174number of events in the keyboard macro. Each item in that list
175will contain the code to evaluate after the corresponding event
176in the keyboard macro, either nil or a thunk built from the forms
177in the original list. Return a list containing the keyboard
178macro as the first item, followed by the list of thunks and/or
179nils."
180 (cl-loop
181 for item = (pop macro)
182 while item
183 for segment = (read-kbd-macro item)
184 for thunk = (edebug-tests-wrap-thunk
185 (cl-loop
186 for form in macro
187 until (or (stringp form) (vectorp form))
188 collect form
189 do (pop macro)))
190 vconcat segment into segments
191 append (edebug-tests-pad-thunk-list (length segment) thunk)
192 into thunk-list
193
194 finally return (cons segments thunk-list)))
195
196 (defun edebug-tests-wrap-thunk (body)
197 "If BODY is non-nil, wrap it with a lambda form."
198 (when body
199 `(lambda () ,@body)))
200
201 (defun edebug-tests-pad-thunk-list (length thunk)
202 "Return a list with LENGTH elements with THUNK in the last position.
203All other elements will be nil."
204 (let ((thunk-seg (make-list length nil)))
205 (setf (car (last thunk-seg)) thunk)
206 thunk-seg)))
207
208;;; Support for test execution:
209
210(defvar edebug-tests-thunks nil
211 "List containing thunks to run after each command in a keyboard macro.")
212(defvar edebug-tests-kbd-macro-index nil
213 "Index into `edebug-tests-run-unpacked-kbd-macro's current keyboard macro.")
214
215(defun edebug-tests-run-macro (kbdmac &rest thunks)
216 "Run a keyboard macro and execute a thunk after each command in it.
217KBDMAC should be a vector of events and THUNKS a list of the
218same length containing thunks and/or nils. Run the macro, and
219after the execution of every command in the macro (which may not
220be the same as every keystroke) execute the thunk at the same
221index."
222 (let* ((edebug-tests-thunks thunks)
223 (edebug-tests-kbd-macro-index 0)
224 saved-local-map)
225 (with-current-buffer (find-file-noselect edebug-tests-temp-file)
226 (setq saved-local-map overriding-local-map)
227 (setq overriding-local-map edebug-tests-keymap)
228 (add-hook 'post-command-hook 'edebug-tests-post-command))
229 (advice-add 'exit-recursive-edit
230 :around 'edebug-tests-preserve-keyboard-macro-state)
231 (unwind-protect
232 (kmacro-call-macro nil nil nil kbdmac)
233 (advice-remove 'exit-recursive-edit
234 'edebug-tests-preserve-keyboard-macro-state)
235 (with-current-buffer (find-file-noselect edebug-tests-temp-file)
236 (setq overriding-local-map saved-local-map)
237 (remove-hook 'post-command-hook 'edebug-tests-post-command)))))
238
239(defun edebug-tests-preserve-keyboard-macro-state (orig &rest args)
240 "Call ORIG with ARGS preserving the value of `executing-kbd-macro'.
241Useful to prevent `exit-recursive-edit' from stopping the current
242keyboard macro."
243 (let ((executing-kbd-macro executing-kbd-macro))
244 (apply orig args)))
245
246(defun edebug-tests-post-command ()
247 "Run the thunk from `edebug-tests-thunks' matching the keyboard macro index."
248 (when (and edebug-tests-kbd-macro-index
249 (> executing-kbd-macro-index edebug-tests-kbd-macro-index))
250 (let ((thunk (nth (1- executing-kbd-macro-index) edebug-tests-thunks)))
251 (when thunk
252 (condition-case err
253 (funcall thunk)
254 (error
255 (setq edebug-tests-failure-in-post-command err)
256 (signal (car err) (cdr err)))))
257 (setq edebug-tests-kbd-macro-index executing-kbd-macro-index))))
258
259(defvar edebug-tests-func nil
260 "Instrumented function used to launch Edebug.")
261(defvar edebug-tests-args nil
262 "Arguments for `edebug-tests-func'.")
263
264(defun edebug-tests-setup-@ (def-name args edebug-it)
265 "Set up the binding for @ in `edebug-tests-keymap'.
266Find a definition for DEF-NAME in the current buffer and evaluate it.
267Set globals so that `edebug-tests-call-instrumented-func' which
268is bound to @ for edebug-tests' keyboard macros will call it with
269ARGS. EDEBUG-IT is passed through to `eval-defun'."
270 (edebug-tests-locate-def def-name)
271 (eval-defun edebug-it)
272 (let* ((full-name (concat "edebug-test-code-" def-name))
273 (sym (intern-soft full-name)))
274 (should (and sym (fboundp sym)))
275 (setq edebug-tests-func sym
276 edebug-tests-args args)
277 (setq edebug-tests-@-result 'no-result)))
278
279(defun edebug-tests-call-instrumented-func ()
280 "Call `edebug-tests-func' with `edebug-tests-args' and save the results."
281 (interactive)
282 (let ((result (apply edebug-tests-func edebug-tests-args)))
283 (should (eq edebug-tests-@-result 'no-result))
284 (setq edebug-tests-@-result result)))
285
286(defun edebug-tests-should-be-at (def-name point-name)
287 "Require that point be at the location in DEF-NAME named POINT-NAME.
288DEF-NAME should be the suffix of a definition in the code samples
289file (the part after \"edebug-tests\")."
290 (let ((stop-point (edebug-tests-get-stop-point def-name point-name)))
291 (should (eq (current-buffer) (find-file-noselect edebug-tests-temp-file)))
292 (should (eql (point) stop-point))))
293
294(defun edebug-tests-get-stop-point (def-name point-name)
295 "Return the position in DEF-NAME of the stop point named POINT-NAME.
296DEF-NAME should be the suffix of a definition in the code samples
297file (the part after \"edebug-tests\")."
298 (let* ((full-name (concat "edebug-test-code-" def-name))(stop-point
299 (cdr (assoc point-name
300 (cdr (assoc full-name edebug-tests-stop-points))))))
301 (unless stop-point
302 (ert-fail (format "%s not found in %s" point-name full-name)))
303 stop-point))
304
305(defun edebug-tests-should-match-result-in-messages (value)
306 "Require that VALUE (a string) match an Edebug result in *Messages*.
307Then clear edebug-tests' saved messages."
308 (should (string-match-p (concat "Result: " (regexp-quote value) "$")
309 edebug-tests-messages))
310 (setq edebug-tests-messages ""))
311
312(defun edebug-tests-locate-def (def-name)
313 "Search for a definition of DEF-NAME from the start of the current buffer.
314Place point at the end of DEF-NAME in the buffer."
315 (goto-char (point-min))
316 (re-search-forward (concat "def\\S-+ edebug-test-code-" def-name)))
317
318(defconst edebug-tests-start-of-next-def-regexp "^(\\S-*def\\S-+ \\(\\S-+\\)"
319 "Regexp used to match the start of a definition.")
320(defconst edebug-tests-stop-point-regexp "!\\(\\S-+?\\)!"
321 "Regexp used to match a stop point annotation in the sample code.")
322
323;;; Set up buffer containing code samples:
324
325(defmacro edebug-tests-deduplicate (name names-and-numbers)
326 "Return a unique variation on NAME.
327NAME should be a string and NAMES-AND-NUMBERS an alist which can
328be used by this macro to retain state. If NAME for example is
329\"symbol\" then the first and subsequent uses of this macro will
330evaluate to \"symbol\", \"symbol-1\", \"symbol-2\", etc."
331 (let ((g-name (gensym))
332 (g-duplicate (gensym)))
333 `(let* ((,g-name ,name)
334 (,g-duplicate (assoc ,g-name ,names-and-numbers)))
335 (if (null ,g-duplicate)
336 (progn
337 (push (cons ,g-name 0) ,names-and-numbers)
338 ,g-name)
339 (cl-incf (cdr ,g-duplicate))
340 (format "%s-%s" ,g-name (cdr ,g-duplicate))))))
341
342(defun edebug-tests-setup-code-file (tmpfile)
343 "Extract stop points and loadable code from the sample code file.
344Write the loadable code to a buffer for TMPFILE, and set
345`edebug-tests-stop-points' to a map from defined symbols to stop
346point names to positions in the file."
347 (with-current-buffer (find-file-noselect edebug-tests-sample-code-file)
348 (let ((marked-up-code (buffer-string)))
349 (with-temp-file tmpfile
350 (insert marked-up-code))))
351
352 (with-current-buffer (find-file-noselect tmpfile)
353 (let ((stop-points
354 ;; Delete all the !name! annotations from the code, but remember
355 ;; their names and where they were in an alist.
356 (cl-loop
357 initially (goto-char (point-min))
358 while (re-search-forward edebug-tests-stop-point-regexp nil t)
359 for name = (match-string-no-properties 1)
360 do (replace-match "")
361 collect (cons name (point))))
362 names-and-numbers)
363
364 ;; Now build an alist mapping definition names to annotation
365 ;; names and positions.
366 ;; If duplicate symbols exist in the file, enter them in the
367 ;; alist as symbol, symbol-1, symbol-2 etc.
368 (setq edebug-tests-stop-points
369 (cl-loop
370 initially (goto-char (point-min))
371 while (re-search-forward edebug-tests-start-of-next-def-regexp
372 nil t)
373 for name =
374 (edebug-tests-deduplicate (match-string-no-properties 1)
375 names-and-numbers)
376 for end-of-def =
377 (save-match-data
378 (save-excursion
379 (re-search-forward edebug-tests-start-of-next-def-regexp
380 nil 0)
381 (point)))
382 collect (cons name
383 (cl-loop
384 while (and stop-points
385 (< (cdar stop-points) end-of-def))
386 collect (pop stop-points))))))))
387
388;;; Tests
389
390(ert-deftest edebug-tests-check-keymap ()
391 "Verify that `edebug-mode-map' is compatible with these tests.
392If this test fails, one of two things is true. Either your
393customizations modify `edebug-mode-map', in which case starting
394Emacs with the -Q flag should fix the problem, or
395`edebug-mode-map' has changed in edebug.el, in which case this
396test and possibly others should be updated."
397 ;; The reason verify-keybinding is a macro instead of a function is
398 ;; that in the event of a failure, it makes the keybinding that
399 ;; failed show up in ERT's output.
400 (cl-macrolet ((verify-keybinding (key binding)
401 `(should (eq (lookup-key edebug-mode-map ,key)
402 ,binding))))
403 (verify-keybinding " " 'edebug-step-mode)
404 (verify-keybinding "n" 'edebug-next-mode)
405 (verify-keybinding "g" 'edebug-go-mode)
406 (verify-keybinding "G" 'edebug-Go-nonstop-mode)
407 (verify-keybinding "t" 'edebug-trace-mode)
408 (verify-keybinding "T" 'edebug-Trace-fast-mode)
409 (verify-keybinding "c" 'edebug-continue-mode)
410 (verify-keybinding "C" 'edebug-Continue-fast-mode)
411 (verify-keybinding "f" 'edebug-forward-sexp)
412 (verify-keybinding "h" 'edebug-goto-here)
413 (verify-keybinding "I" 'edebug-instrument-callee)
414 (verify-keybinding "i" 'edebug-step-in)
415 (verify-keybinding "o" 'edebug-step-out)
416 (verify-keybinding "q" 'top-level)
417 (verify-keybinding "Q" 'edebug-top-level-nonstop)
418 (verify-keybinding "a" 'abort-recursive-edit)
419 (verify-keybinding "S" 'edebug-stop)
420 (verify-keybinding "b" 'edebug-set-breakpoint)
421 (verify-keybinding "u" 'edebug-unset-breakpoint)
422 (verify-keybinding "B" 'edebug-next-breakpoint)
423 (verify-keybinding "x" 'edebug-set-conditional-breakpoint)
424 (verify-keybinding "X" 'edebug-set-global-break-condition)
425 (verify-keybinding "r" 'edebug-previous-result)
426 (verify-keybinding "e" 'edebug-eval-expression)
427 (verify-keybinding "\C-x\C-e" 'edebug-eval-last-sexp)
428 (verify-keybinding "E" 'edebug-visit-eval-list)
429 (verify-keybinding "w" 'edebug-where)
430 (verify-keybinding "v" 'edebug-view-outside) ;; maybe obsolete??
431 (verify-keybinding "p" 'edebug-bounce-point)
432 (verify-keybinding "P" 'edebug-view-outside) ;; same as v
433 (verify-keybinding "W" 'edebug-toggle-save-windows)
434 (verify-keybinding "?" 'edebug-help)
435 (verify-keybinding "d" 'edebug-backtrace)
436 (verify-keybinding "-" 'negative-argument)
437 (verify-keybinding "=" 'edebug-temp-display-freq-count)))
438
439(ert-deftest edebug-tests-stop-point-at-start-of-first-instrumented-function ()
440 "Edebug stops at the beginning of an instrumented function."
441 (edebug-tests-with-normal-env
442 (edebug-tests-setup-@ "fac" '(0) t)
443 (edebug-tests-run-kbd-macro
444 "@" (edebug-tests-should-be-at "fac" "start")
445 "SPC" (edebug-tests-should-be-at "fac" "step")
446 "g" (should (equal edebug-tests-@-result 1)))))
447
448(ert-deftest edebug-tests-step-showing-evaluation-results ()
449 "Edebug prints expression evaluation results to the echo area."
450 (edebug-tests-with-normal-env
451 (edebug-tests-setup-@ "concat" '("x" "y" nil) t)
452 (edebug-tests-run-kbd-macro
453 "@" (edebug-tests-should-be-at "concat" "start")
454 "SPC" (edebug-tests-should-be-at "concat" "flag")
455 (edebug-tests-should-match-result-in-messages "nil")
456 "SPC" (edebug-tests-should-be-at "concat" "else-start")
457 "SPC" (edebug-tests-should-be-at "concat" "else-b")
458 (edebug-tests-should-match-result-in-messages "\"y\"")
459 "SPC" (edebug-tests-should-be-at "concat" "else-a")
460 (edebug-tests-should-match-result-in-messages "\"x\"")
461 "SPC" (edebug-tests-should-be-at "concat" "else-concat")
462 (edebug-tests-should-match-result-in-messages "\"yx\"")
463 "SPC" (edebug-tests-should-be-at "concat" "if")
464 (edebug-tests-should-match-result-in-messages "\"yx\"")
465 "SPC" (should (equal edebug-tests-@-result "yx")))))
466
467(ert-deftest edebug-tests-set-breakpoint-at-point ()
468 "Edebug can set a breakpoint at point."
469 (edebug-tests-with-normal-env
470 (edebug-tests-setup-@ "concat" '("x" "y" t) t)
471 (edebug-tests-run-kbd-macro
472 "@" (edebug-tests-should-be-at "concat" "start")
473 "C-n C-e b C-n" ; Move down, set a breakpoint and move away.
474 "g" (edebug-tests-should-be-at "concat" "then-concat")
475 (edebug-tests-should-match-result-in-messages "\"xy\"")
476 "g" (should (equal edebug-tests-@-result "xy")))))
477
478(ert-deftest edebug-tests-set-temporary-breakpoint-at-point ()
479 "Edebug can set a temporary breakpoint at point."
480 (edebug-tests-with-normal-env
481 (edebug-tests-setup-@ "range" '(3) t)
482 (edebug-tests-run-kbd-macro
483 "@" (edebug-tests-should-be-at "range" "start")
484 "C-n C-n C-n C-e" ; Move down to the end of a sexp in the loop.
485 "C-u b" ; Set a temporary breakpoint.
486 "C-n" ; Move away.
487 "g" (edebug-tests-should-be-at "range" "loop")
488 (edebug-tests-should-match-result-in-messages "(0)")
489 "g" (should (equal edebug-tests-@-result '(0 1 2))))))
490
491(ert-deftest edebug-tests-clear-breakpoint ()
492 "Edebug can clear a breakpoint."
493 (edebug-tests-with-normal-env
494 (edebug-tests-setup-@ "range" '(3) t)
495 (edebug-tests-run-kbd-macro
496 "@"
497 (message "after @")
498 (edebug-tests-should-be-at "range" "start")
499 "C-n C-n C-n C-e b C-n" ; Move down, set a breakpoint and move away.
500 "g" (edebug-tests-should-be-at "range" "loop")
501 (edebug-tests-should-match-result-in-messages "(0)")
502 "g" (edebug-tests-should-be-at "range" "loop")
503 (edebug-tests-should-match-result-in-messages "(1 0)")
504 "u" ; Unset the breakpoint.
505 "g" (should (equal edebug-tests-@-result '(0 1 2))))))
506
507(ert-deftest edebug-tests-move-point-to-next-breakpoint ()
508 "Edebug can move point to the next breakpoint."
509 (edebug-tests-with-normal-env
510 (edebug-tests-setup-@ "concat" '("a" "b" nil) t)
511 (edebug-tests-run-kbd-macro
512 "@" (edebug-tests-should-be-at "concat" "start")
513 "C-n C-e b" ; Move down, set a breakpoint.
514 "C-n b" ; Set another breakpoint on the next line.
515 "C-p C-p C-p" ; Move back up.
516 "B" (edebug-tests-should-be-at "concat" "then-concat")
517 "B" (edebug-tests-should-be-at "concat" "else-concat")
518 "G" (should (equal edebug-tests-@-result "ba")))))
519
520(ert-deftest edebug-tests-move-point-back-to-stop-point ()
521 "Edebug can move point back to a stop point."
522 (edebug-tests-with-normal-env
523 (let ((test-buffer (get-buffer-create "edebug-tests-temp")))
524 (edebug-tests-setup-@ "fac" '(4) t)
525 (edebug-tests-run-kbd-macro
526 "@" (edebug-tests-should-be-at "fac" "start")
527 "C-n w" (edebug-tests-should-be-at "fac" "start")
528 (pop-to-buffer test-buffer)
529 "C-x X w" (edebug-tests-should-be-at "fac" "start")
530 "g" (should (equal edebug-tests-@-result 24)))
531 (ignore-errors (kill-buffer test-buffer)))))
532
533(ert-deftest edebug-tests-jump-to-point ()
534 "Edebug can stop at a temporary breakpoint at point."
535 (edebug-tests-with-normal-env
536 (edebug-tests-setup-@ "range" '(3) t)
537 (edebug-tests-run-kbd-macro
538 "@" (edebug-tests-should-be-at "range" "start")
539 "C-n C-n C-n C-e" ; Move down to the end of a sexp in the loop.
540 "h" (edebug-tests-should-be-at "range" "loop")
541 (edebug-tests-should-match-result-in-messages "(0)")
542 "g" (should (equal edebug-tests-@-result '(0 1 2))))))
543
544(ert-deftest edebug-tests-jump-forward-one-sexp ()
545 "Edebug can run the program for one expression."
546 (edebug-tests-with-normal-env
547 (edebug-tests-setup-@ "range" '(3) t)
548 (edebug-tests-run-kbd-macro
549 "@" (edebug-tests-should-be-at "range" "start")
550 "SPC SPC f" (edebug-tests-should-be-at "range" "test")
551 "g" (should (equal edebug-tests-@-result '(0 1 2))))))
552
553(ert-deftest edebug-tests-run-out-of-containing-sexp ()
554 "Edebug can run the program until the end of the containing sexp."
555 (edebug-tests-with-normal-env
556 (edebug-tests-setup-@ "range" '(3) t)
557 (edebug-tests-run-kbd-macro
558 "@" (edebug-tests-should-be-at "range" "start")
559 "SPC SPC f" (edebug-tests-should-be-at "range" "test")
560 "o" (edebug-tests-should-be-at "range" "end-loop")
561 (edebug-tests-should-match-result-in-messages "nil")
562 "g" (should (equal edebug-tests-@-result '(0 1 2))))))
563
564(ert-deftest edebug-tests-observe-breakpoint-in-source ()
565 "Edebug will stop at a breakpoint embedded in source code."
566 (edebug-tests-with-normal-env
567 (edebug-tests-setup-@ "choices" '(8) t)
568 (edebug-tests-run-kbd-macro
569 "@" (edebug-tests-should-be-at "choices" "start")
570 "g" (edebug-tests-should-be-at "choices" "edebug")
571 "g" (should (equal edebug-tests-@-result nil)))))
572
573(ert-deftest edebug-tests-set-conditional-breakpoint ()
574 "Edebug can set and observe a conditional breakpoint."
575 (edebug-tests-with-normal-env
576 (edebug-tests-setup-@ "fac" '(5) t)
577 (edebug-tests-run-kbd-macro
578 "@" (edebug-tests-should-be-at "fac" "start")
579 ;; Set conditional breakpoint at end of next line.
580 "C-n C-e x (eql SPC n SPC 3) RET"
581 "g" (edebug-tests-should-be-at "fac" "mult")
582 (edebug-tests-should-match-result-in-messages "6 (#o6, #x6, ?\\C-f)")
583 "g" (should (equal edebug-tests-@-result 120)))))
584
585(ert-deftest edebug-tests-error-trying-to-set-breakpoint-in-uninstrumented-code
586 ()
587 "Edebug refuses to set a breakpoint in uninstrumented code."
588 (edebug-tests-with-normal-env
589 (edebug-tests-setup-@ "fac" '(5) t)
590 (let* ((debug-on-error nil)
591 (edebug-on-error nil)
592 error-message
593 (command-error-function (lambda (&rest args)
594 (setq error-message (cadar args)))))
595 (edebug-tests-run-kbd-macro
596 "@" (edebug-tests-should-be-at "fac" "start")
597 "C-u 10 C-n" ; Move down and out of instrumented function.
598 "b" (should (string-match-p "Not inside instrumented form"
599 error-message))
600 ;; The error stopped the keyboard macro. Start it again.
601 (should-not executing-kbd-macro)
602 (setq executing-kbd-macro t)
603 "g"))))
604
605(ert-deftest edebug-tests-set-and-break-on-global-condition ()
606 "Edebug can break when a global condition becomes true."
607 (edebug-tests-with-normal-env
608 (edebug-tests-setup-@ "multiply" '(5 3) t)
609 (edebug-tests-run-kbd-macro
610 "@" (edebug-tests-should-be-at "multiply" "start")
611 "X (> SPC edebug-test-code-total SPC 10) RET"
612 (should edebug-global-break-condition)
613 "g" (edebug-tests-should-be-at "multiply" "setq")
614 (should (eql (symbol-value 'edebug-test-code-total) 12))
615 "X C-a C-k nil RET" ; Remove suggestion before entering nil.
616 "g" (should (equal edebug-tests-@-result 15)))))
617
618(ert-deftest edebug-tests-trace-showing-results-at-stop-points ()
619 "Edebug can trace execution, showing results at stop points."
620 (edebug-tests-with-normal-env
621 (edebug-tests-setup-@ "concat" '("x" "y" nil) t)
622 (edebug-tests-run-kbd-macro
623 "@" (edebug-tests-should-be-at "concat" "start")
624 "T" (should (string-match-p
625 (concat "Result: nil\n.*?"
626 "Result: \"y\"\n.*?"
627 "Result: \"x\"\n.*?"
628 "Result: \"yx\"\n.*?"
629 "Result: \"yx\"\n")
630 edebug-tests-messages))
631 (should (equal edebug-tests-@-result "yx")))))
632
633(ert-deftest edebug-tests-trace-showing-results-at-breakpoints ()
634 "Edebug can trace execution, showing results at breakpoints."
635 (edebug-tests-with-normal-env
636 (edebug-tests-locate-def "format-vector-node")
637 (edebug-tests-run-kbd-macro "C-u C-M-x C-n C-n C-e C-x X b")
638 (edebug-tests-locate-def "format-list-node")
639 (edebug-tests-run-kbd-macro "C-u C-M-x C-n C-n C-e C-x X b")
640 (edebug-tests-setup-@ "format-node" '(([a b] [c d])) t)
641 (edebug-tests-run-kbd-macro
642 "@" (edebug-tests-should-be-at "format-node" "start")
643 "C" (should (string-match-p
644 (concat "Result: \"ab\"\n.*?"
645 "Result: \"cd\"\n.*?"
646 "Result: \"\\[ab]\\[cd]\"\n")
647 edebug-tests-messages))
648 (should (equal edebug-tests-@-result "{[ab][cd]}")))))
649
650(ert-deftest edebug-tests-trace-function-call-and-return ()
651 "Edebug can create a trace of function calls and returns."
652 (edebug-tests-with-normal-env
653 (edebug-tests-locate-def "format-vector-node")
654 (eval-defun t)
655 (edebug-tests-locate-def "format-list-node")
656 (eval-defun t)
657 (edebug-tests-setup-@ "format-node" '((a [b])) t)
658 (let ((edebug-trace t)
659 (trace-start (with-current-buffer
660 (get-buffer-create edebug-trace-buffer) (point-max))))
661 (edebug-tests-run-kbd-macro
662 "@" (edebug-tests-should-be-at "format-node" "start")
663 "g" (should (equal edebug-tests-@-result "{a[b]}")))
664 (with-current-buffer edebug-trace-buffer
665 (should (string=
666 "{ edebug-test-code-format-node args: ((a [b]))
667:{ edebug-test-code-format-list-node args: ((a [b]))
668::{ edebug-test-code-format-node args: (a)
669::} edebug-test-code-format-node result: a
670::{ edebug-test-code-format-node args: ([b])
671:::{ edebug-test-code-format-vector-node args: ([b])
672::::{ edebug-test-code-format-node args: (b)
673::::} edebug-test-code-format-node result: b
674:::} edebug-test-code-format-vector-node result: [b]
675::} edebug-test-code-format-node result: [b]
676:} edebug-test-code-format-list-node result: {a[b]}
677} edebug-test-code-format-node result: {a[b]}
678" (buffer-substring trace-start (point-max))))))))
679
680(ert-deftest edebug-tests-evaluate-expressions ()
681 "Edebug can evaluate an expression in the context outside of itself."
682 (edebug-tests-with-normal-env
683 (edebug-tests-setup-@ "range" '(2) t)
684 (edebug-tests-run-kbd-macro
685 "@" (edebug-tests-should-be-at "range" "start")
686 "SPC SPC f" (edebug-tests-should-be-at "range" "test")
687 (edebug-tests-should-match-result-in-messages "t")
688 "e (- SPC num SPC index) RET"
689 ;; Edebug just prints the result without "Result:"
690 (should (string-match-p
691 (regexp-quote "2 (#o2, #x2, ?\\C-b)")
692 edebug-tests-messages))
693 "g" (should (equal edebug-tests-@-result '(0 1))))
694
695 ;; Do it again with lexical-binding turned off.
696 (setq lexical-binding nil)
697 (eval-buffer)
698 (should-not lexical-binding)
699 (edebug-tests-setup-@ "range" '(2) t)
700 (edebug-tests-run-kbd-macro
701 "@" (edebug-tests-should-be-at "range" "start")
702 "SPC SPC f" (edebug-tests-should-be-at "range" "test")
703 (edebug-tests-should-match-result-in-messages "t")
704 "e (- SPC num SPC index) RET"
705 ;; Edebug just prints the result without "Result:"
706 (should (string-match-p
707 (regexp-quote "2 (#o2, #x2, ?\\C-b)")
708 edebug-tests-messages))
709 "g" (should (equal edebug-tests-@-result '(0 1))))))
710
711(ert-deftest edebug-tests-step-into-function ()
712 "Edebug can step into a function."
713 (edebug-tests-with-normal-env
714 (edebug-tests-setup-@ "format-node" '([b]) t)
715 (edebug-tests-run-kbd-macro
716 "@" (edebug-tests-should-be-at "format-node" "start")
717 "SPC SPC SPC SPC"
718 (edebug-tests-should-be-at "format-node" "vbefore")
719 "i" (edebug-tests-should-be-at "format-vector-node" "start")
720 "g" (should (equal edebug-tests-@-result "[b]")))))
721
722(ert-deftest edebug-tests-error-stepping-into-subr ()
723 "Edebug refuses to step into a C function."
724 (edebug-tests-with-normal-env
725 (edebug-tests-setup-@ "format-node" '([b]) t)
726 (let* ((debug-on-error nil)
727 (edebug-on-error nil)
728 error-message
729 (command-error-function (lambda (&rest args)
730 (setq error-message (cl-cadar args)))))
731 (edebug-tests-run-kbd-macro
732 "@" (edebug-tests-should-be-at "format-node" "start")
733 "SPC" (edebug-tests-should-be-at "format-node" "vectorp")
734 "i" (should (string-match-p "vectorp is a built-in function"
735 error-message))
736 ;; The error stopped the keyboard macro. Start it again.
737 (should-not executing-kbd-macro)
738 (setq executing-kbd-macro t)
739 "g" (should (equal edebug-tests-@-result "[b]"))))))
740
741(ert-deftest edebug-tests-step-into-macro-error ()
742 "Edebug gives an error on trying to step into a macro (Bug#26847)."
743 :expected-result :failed
744 (ert-fail "Forcing failure because letting this test run aborts the others.")
745 (edebug-tests-with-normal-env
746 (edebug-tests-setup-@ "try-flavors" nil t)
747 (let* ((debug-on-error nil)
748 (edebug-on-error nil)
749 (error-message "")
750 (command-error-function (lambda (&rest args)
751 (setq error-message (cl-cadar args)))))
752 (edebug-tests-run-kbd-macro
753 "@ SPC SPC SPC SPC SPC"
754 (edebug-tests-should-be-at "try-flavors" "macro")
755 "i" (should (string-match-p "edebug-test-code-try-flavors is a macro"
756 error-message))
757 ;; The error stopped the keyboard macro. Start it again.
758 (should-not executing-kbd-macro)
759 (setq executing-kbd-macro t)
760 "g" (should (equal edebug-tests-@-result
761 '("chocolate" "strawberry")))))))
762
763(ert-deftest edebug-tests-step-into-generic-method ()
764 "Edebug can step into a generic method (Bug#22294)."
765 (edebug-tests-with-normal-env
766 (edebug-tests-setup-@ "use-methods" nil t)
767 (edebug-tests-run-kbd-macro
768 "@ SPC" (edebug-tests-should-be-at "use-methods" "number")
769 "i" (edebug-tests-should-be-at "emphasize-1" "start")
770 "gg" (should (equal edebug-tests-@-result
771 '("The number is not 101 or 99, but 100!"
772 "***yes***"))))))
773
774(ert-deftest edebug-tests-break-in-lambda-out-of-defining-context ()
775 "Edebug observes a breakpoint in a lambda executed out of defining context."
776 (edebug-tests-with-normal-env
777 (edebug-tests-locate-def "make-lambda")
778 (eval-defun t)
779 (goto-char (edebug-tests-get-stop-point "make-lambda" "x"))
780 (edebug-set-breakpoint t)
781 (edebug-tests-setup-@ "use-lambda" nil t)
782 (edebug-tests-run-kbd-macro
783 "@g" (edebug-tests-should-be-at "make-lambda" "x")
784 (edebug-tests-should-match-result-in-messages "1 (#o1, #x1, ?\\C-a)")
785 "g" (should (equal edebug-tests-@-result '(11 12 13))))))
786
787(ert-deftest edebug-tests-respects-initial-mode ()
788 "Edebug can stop first at breakpoint instead of first instrumented function."
789 (edebug-tests-with-normal-env
790 (edebug-tests-setup-@ "fac" '(4) t)
791 (goto-char (edebug-tests-get-stop-point "fac" "mult"))
792 (edebug-set-breakpoint t)
793 (setq edebug-initial-mode 'go)
794 (edebug-tests-run-kbd-macro
795 "@" (edebug-tests-should-be-at "fac" "mult")
796 (edebug-tests-should-match-result-in-messages "1 (#o1, #x1, ?\\C-a)")
797 "G" (should (equal edebug-tests-@-result 24)))))
798
799(ert-deftest edebug-tests-step-through-non-definition ()
800 "Edebug can step through a non-defining form."
801 (edebug-tests-with-normal-env
802 (goto-char (edebug-tests-get-stop-point "try-flavors" "end-unless"))
803 (edebug-tests-run-kbd-macro
804 "C-u C-M-x"
805 "SPC SPC" (edebug-tests-should-be-at "try-flavors" "nutty")
806 (edebug-tests-should-match-result-in-messages "nil")
807 "SPC" (edebug-tests-should-be-at "try-flavors" "setq")
808 "f" (edebug-tests-should-be-at "try-flavors" "end-setq")
809 (edebug-tests-should-match-result-in-messages "\"chocolate\"")
810 "g")))
811
812(ert-deftest edebug-tests-conditional-breakpoints-can-use-lexical-variables ()
813 "Edebug can set a conditional breakpoint using a lexical variable. Bug#12685"
814 (edebug-tests-with-normal-env
815 (should lexical-binding)
816 (edebug-tests-setup-@ "fac" '(5) t)
817 (edebug-tests-run-kbd-macro
818 "@" (edebug-tests-should-be-at "fac" "start")
819 ;; Set conditional breakpoint at end of next line.
820 "C-n C-e x (eql SPC n SPC 3) RET"
821 "g" (edebug-tests-should-be-at "fac" "mult")
822 (edebug-tests-should-match-result-in-messages
823 "6 (#o6, #x6, ?\\C-f)"))))
824
825(ert-deftest edebug-tests-writable-buffer-state-is-preserved ()
826 "On Edebug exit writable buffers are still writable (Bug#14144)."
827 (edebug-tests-with-normal-env
828 (edebug-tests-setup-@ "choices" '(0) t)
829 (read-only-mode -1)
830 (edebug-tests-run-kbd-macro
831 "@g" (should (equal edebug-tests-@-result "zero")))
832 (barf-if-buffer-read-only)))
833
834(ert-deftest edebug-tests-list-containing-empty-string-result-printing ()
835 "Edebug correctly prints a list containing only an empty string (Bug#17934)."
836 (edebug-tests-with-normal-env
837 (edebug-tests-setup-@ "empty-string-list" nil t)
838 (edebug-tests-run-kbd-macro
839 "@ SPC" (edebug-tests-should-be-at
840 "empty-string-list" "step")
841 (edebug-tests-should-match-result-in-messages "(\"\")")
842 "g")))
843
844(ert-deftest edebug-tests-evaluation-of-current-buffer-bug-19611 ()
845 "Edebug can evaluate `current-buffer' in correct context. (Bug#19611)."
846 (edebug-tests-with-normal-env
847 (edebug-tests-setup-@ "current-buffer" nil t)
848 (edebug-tests-run-kbd-macro
849 "@" (edebug-tests-should-be-at
850 "current-buffer" "start")
851 "SPC SPC SPC" (edebug-tests-should-be-at
852 "current-buffer" "body")
853 "e (current-buffer) RET"
854 ;; Edebug just prints the result without "Result:"
855 (should (string-match-p
856 (regexp-quote "*edebug-test-code-buffer*")
857 edebug-tests-messages))
858 "g" (should (equal edebug-tests-@-result
859 "current-buffer: *edebug-test-code-buffer*")))))
860
861(ert-deftest edebug-tests-trivial-backquote ()
862 "Edebug can instrument a trivial backquote expression (Bug#23651)."
863 (edebug-tests-with-normal-env
864 (read-only-mode -1)
865 (delete-region (point-min) (point-max))
866 (insert "`1")
867 (read-only-mode)
868 (edebug-eval-defun nil)
869 (should (string-match-p (regexp-quote "1 (#o1, #x1, ?\\C-a)")
870 edebug-tests-messages))
871 (setq edebug-tests-messages "")
872
873 (setq edebug-initial-mode 'go)
874 ;; In Bug#23651 Edebug would hang reading `1.
875 (edebug-eval-defun t)))
876
877(ert-deftest edebug-tests-trivial-comma ()
878 "Edebug can read a trivial comma expression (Bug#23651)."
879 (edebug-tests-with-normal-env
880 (read-only-mode -1)
881 (delete-region (point-min) (point-max))
882 (insert ",1")
883 (read-only-mode)
884 (should-error (edebug-eval-defun t))))
885
886(ert-deftest edebug-tests-circular-read-syntax ()
887 "Edebug can instrument code using circular read object syntax (Bug#23660)."
888 (edebug-tests-with-normal-env
889 (edebug-tests-setup-@ "circular-read-syntax" nil t)
890 (edebug-tests-run-kbd-macro
891 "@" (should (eql (car edebug-tests-@-result)
892 (cdr edebug-tests-@-result))))))
893
894(ert-deftest edebug-tests-hash-read-syntax ()
895 "Edebug can instrument code which uses # read syntax (Bug#25068)."
896 (edebug-tests-with-normal-env
897 (edebug-tests-setup-@ "hash-read-syntax" nil t)
898 (edebug-tests-run-kbd-macro
899 "@g" (should (equal edebug-tests-@-result
900 '(#("abcd" 1 3 (face italic)) 511))))))
901
902(provide 'edebug-tests)
903;;; edebug-tests.el ends here
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el
index 2c6740a96cf..0e8871d9a9c 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -397,9 +397,14 @@
397 (should (equal 1 (let ((x 1)) (and-let* (x))))) 397 (should (equal 1 (let ((x 1)) (and-let* (x)))))
398 (should (equal nil (and-let* ((x nil))))) 398 (should (equal nil (and-let* ((x nil)))))
399 (should (equal 1 (and-let* ((x 1))))) 399 (should (equal 1 (and-let* ((x 1)))))
400 (should-error (and-let* (nil (x 1))) :type 'setting-constant) 400 ;; The error doesn't trigger when compiled: the compiler will give
401 ;; a warning and then drop the erroneous code. Therefore, use
402 ;; `eval' to avoid compilation.
403 (should-error (eval '(and-let* (nil (x 1))) lexical-binding)
404 :type 'setting-constant)
401 (should (equal nil (and-let* ((nil) (x 1))))) 405 (should (equal nil (and-let* ((nil) (x 1)))))
402 (should-error (and-let* (2 (x 1))) :type 'wrong-type-argument) 406 (should-error (eval (and-let* (2 (x 1))) lexical-binding)
407 :type 'wrong-type-argument)
403 (should (equal 1 (and-let* ((2) (x 1))))) 408 (should (equal 1 (and-let* ((2) (x 1)))))
404 (should (equal 2 (and-let* ((x 1) (2))))) 409 (should (equal 2 (and-let* ((x 1) (2)))))
405 (should (equal nil (let ((x nil)) (and-let* (x) x)))) 410 (should (equal nil (let ((x nil)) (and-let* (x) x))))
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index ef216c3f34a..285a884b695 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -363,7 +363,8 @@ be invoked with the right arguments."
363 (should-not (make-directory subdir1)) 363 (should-not (make-directory subdir1))
364 (should-not (make-directory subdir2 t)) 364 (should-not (make-directory subdir2 t))
365 (should-error (make-directory a/b)) 365 (should-error (make-directory a/b))
366 (should-not (make-directory a/b t)))) 366 (should-not (make-directory a/b t))
367 (delete-directory dir 'recursive)))
367 368
368(ert-deftest files-test-no-file-write-contents () 369(ert-deftest files-test-no-file-write-contents ()
369 "Test that `write-contents-functions' permits saving a file. 370 "Test that `write-contents-functions' permits saving a file.
@@ -393,5 +394,22 @@ name (Bug#28412)."
393 (should (null (save-buffer))) 394 (should (null (save-buffer)))
394 (should (eq (buffer-size) 1)))))) 395 (should (eq (buffer-size) 1))))))
395 396
397(ert-deftest files-tests--copy-directory ()
398 (let* ((dir (make-temp-file "files-mkdir-test" t))
399 (dirname (file-name-as-directory dir))
400 (source (concat dirname "source"))
401 (dest (concat dirname "dest/new/directory/"))
402 (file (concat (file-name-as-directory source) "file"))
403 (source2 (concat dirname "source2"))
404 (dest2 (concat dirname "dest/new2")))
405 (make-directory source)
406 (write-region "" nil file)
407 (copy-directory source dest t t t)
408 (should (file-exists-p (concat dest "file")))
409 (make-directory (concat (file-name-as-directory source2) "a") t)
410 (copy-directory source2 dest2)
411 (should (file-directory-p (concat (file-name-as-directory dest2) "a")))
412 (delete-directory dir 'recursive)))
413
396(provide 'files-tests) 414(provide 'files-tests)
397;;; files-tests.el ends here 415;;; files-tests.el ends here
diff --git a/test/lisp/ibuffer-tests.el b/test/lisp/ibuffer-tests.el
index d65acf60712..35605ca28dc 100644
--- a/test/lisp/ibuffer-tests.el
+++ b/test/lisp/ibuffer-tests.el
@@ -456,11 +456,14 @@
456 (funcall create-non-file-buffer "ibuf-test-8a" 456 (funcall create-non-file-buffer "ibuf-test-8a"
457 :mode #'artist-mode)) 457 :mode #'artist-mode))
458 (bufB (funcall create-non-file-buffer "*ibuf-test-8b*" :size 32)) 458 (bufB (funcall create-non-file-buffer "*ibuf-test-8b*" :size 32))
459 (bufC (funcall create-file-buffer "ibuf-test8c" :suffix "*" 459 (bufC (or (memq system-type '(ms-dos windows-nt))
460 :size 64)) 460 (funcall create-file-buffer "ibuf-test8c" :suffix "*"
461 (bufD (funcall create-file-buffer "*ibuf-test8d" :size 128)) 461 :size 64)))
462 (bufE (funcall create-file-buffer "*ibuf-test8e" :suffix "*<2>" 462 (bufD (or (memq system-type '(ms-dos windows-nt))
463 :size 16)) 463 (funcall create-file-buffer "*ibuf-test8d" :size 128)))
464 (bufE (or (memq system-type '(ms-dos windows-nt))
465 (funcall create-file-buffer "*ibuf-test8e"
466 :suffix "*<2>" :size 16)))
464 (bufF (and (funcall create-non-file-buffer "*ibuf-test8f*") 467 (bufF (and (funcall create-non-file-buffer "*ibuf-test8f*")
465 (funcall create-non-file-buffer "*ibuf-test8f*" 468 (funcall create-non-file-buffer "*ibuf-test8f*"
466 :size 8)))) 469 :size 8))))
@@ -479,22 +482,28 @@
479 (name . "test.*8b") 482 (name . "test.*8b")
480 (size-gt . 31) 483 (size-gt . 31)
481 (not visiting-file))))) 484 (not visiting-file)))))
482 (should (ibuffer-included-in-filters-p 485 ;; MS-DOS and MS-Windows don't allow "*" in file names.
483 bufC '((and (not (starred-name)) 486 (or (memq system-type '(ms-dos windows-nt))
484 (visiting-file) 487 (should (ibuffer-included-in-filters-p
485 (name . "8c[^*]*\\*") 488 bufC '((and (not (starred-name))
486 (size-lt . 65))))) 489 (visiting-file)
487 (should (ibuffer-included-in-filters-p 490 (name . "8c[^*]*\\*")
488 bufD '((and (not (starred-name)) 491 (size-lt . 65))))))
489 (visiting-file) 492 ;; MS-DOS and MS-Windows don't allow "*" in file names.
490 (name . "\\`\\*.*test8d") 493 (or (memq system-type '(ms-dos windows-nt))
491 (size-lt . 129) 494 (should (ibuffer-included-in-filters-p
492 (size-gt . 127))))) 495 bufD '((and (not (starred-name))
493 (should (ibuffer-included-in-filters-p 496 (visiting-file)
494 bufE '((and (starred-name) 497 (name . "\\`\\*.*test8d")
495 (visiting-file) 498 (size-lt . 129)
496 (name . "8e.*?\\*<[[:digit:]]+>") 499 (size-gt . 127))))))
497 (size-gt . 10))))) 500 ;; MS-DOS and MS-Windows don't allow "*" in file names.
501 (or (memq system-type '(ms-dos windows-nt))
502 (should (ibuffer-included-in-filters-p
503 bufE '((and (starred-name)
504 (visiting-file)
505 (name . "8e.*?\\*<[[:digit:]]+>")
506 (size-gt . 10))))))
498 (should (ibuffer-included-in-filters-p 507 (should (ibuffer-included-in-filters-p
499 bufF '((and (starred-name) 508 bufF '((and (starred-name)
500 (not (visiting-file)) 509 (not (visiting-file))
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index e8515302c00..bfdc3017804 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -2653,8 +2653,9 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2653 (tmp-name1 (tramp--test-make-temp-name nil quoted)) 2653 (tmp-name1 (tramp--test-make-temp-name nil quoted))
2654 (tmp-name2 (tramp--test-make-temp-name nil quoted)) 2654 (tmp-name2 (tramp--test-make-temp-name nil quoted))
2655 (tmp-name3 (tramp--test-make-temp-name 'local quoted)) 2655 (tmp-name3 (tramp--test-make-temp-name 'local quoted))
2656 (tmp-name4 (tramp--test-make-temp-name nil quoted))) 2656 (tmp-name4 (tramp--test-make-temp-name nil quoted))
2657 2657 (tmp-name5
2658 (expand-file-name (file-name-nondirectory tmp-name1) tmp-name4)))
2658 ;; Check `make-symbolic-link'. 2659 ;; Check `make-symbolic-link'.
2659 (unwind-protect 2660 (unwind-protect
2660 (tramp--test-ignore-make-symbolic-link-error 2661 (tramp--test-ignore-make-symbolic-link-error
@@ -2716,9 +2717,11 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2716 (funcall 2717 (funcall
2717 (if quoted 'tramp-compat-file-name-unquote 'identity) 2718 (if quoted 'tramp-compat-file-name-unquote 'identity)
2718 (file-remote-p tmp-name1 'localname)) 2719 (file-remote-p tmp-name1 'localname))
2719 (file-symlink-p 2720 (file-symlink-p tmp-name5)))
2720 (expand-file-name 2721 ;; `smbclient' does not show symlinks in directories, so
2721 (file-name-nondirectory tmp-name1) tmp-name4))))) 2722 ;; we cannot delete a non-empty directory. We delete the
2723 ;; file explicitely.
2724 (delete-file tmp-name5))
2722 2725
2723 ;; Cleanup. 2726 ;; Cleanup.
2724 (ignore-errors 2727 (ignore-errors
@@ -2737,7 +2740,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
2737 (should-error 2740 (should-error
2738 (add-name-to-file tmp-name1 tmp-name2) 2741 (add-name-to-file tmp-name1 tmp-name2)
2739 :type 'file-already-exists) 2742 :type 'file-already-exists)
2740 ;; number means interactive case. 2743 ;; A number means interactive case.
2741 (cl-letf (((symbol-function 'yes-or-no-p) 'ignore)) 2744 (cl-letf (((symbol-function 'yes-or-no-p) 'ignore))
2742 (should-error 2745 (should-error
2743 (add-name-to-file tmp-name1 tmp-name2 0) 2746 (add-name-to-file tmp-name1 tmp-name2 0)
@@ -3193,15 +3196,13 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
3193 (should (processp proc)) 3196 (should (processp proc))
3194 (should (process-live-p proc)) 3197 (should (process-live-p proc))
3195 (should (equal (process-status proc) 'run)) 3198 (should (equal (process-status proc) 'run))
3199 (should (numberp (process-get proc 'remote-pid)))
3196 (should (interrupt-process proc)) 3200 (should (interrupt-process proc))
3197 ;; Let the process accept the interrupt. 3201 ;; Let the process accept the interrupt.
3198 (accept-process-output proc 1 nil 0) 3202 (accept-process-output proc 1 nil 0)
3199 (should-not (process-live-p proc)) 3203 (should-not (process-live-p proc))
3200 (should (equal (process-status proc) 'signal))
3201 ;; An interrupted process cannot be interrupted, again. 3204 ;; An interrupted process cannot be interrupted, again.
3202 ;; Does not work reliable. 3205 (should-error (interrupt-process proc) :type 'error))
3203 ;; (should-error (interrupt-process proc) :type 'error))
3204 )
3205 3206
3206 ;; Cleanup. 3207 ;; Cleanup.
3207 (ignore-errors (delete-process proc))))) 3208 (ignore-errors (delete-process proc)))))
@@ -3477,7 +3478,6 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
3477 (skip-unless (tramp--test-enabled)) 3478 (skip-unless (tramp--test-enabled))
3478 (skip-unless (tramp--test-sh-p)) 3479 (skip-unless (tramp--test-sh-p))
3479 3480
3480 ;; TODO: This test fails.
3481 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) 3481 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
3482 (let* ((default-directory tramp-test-temporary-file-directory) 3482 (let* ((default-directory tramp-test-temporary-file-directory)
3483 (tmp-name1 (tramp--test-make-temp-name nil quoted)) 3483 (tmp-name1 (tramp--test-make-temp-name nil quoted))
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index ac9e2df603c..a68688eba7a 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -300,6 +300,12 @@ cf. Bug#25477."
300 (setq res (read-passwd "pass: " 'confirm (mapconcat #'string default ""))) 300 (setq res (read-passwd "pass: " 'confirm (mapconcat #'string default "")))
301 (should (string= default res))))) 301 (should (string= default res)))))
302 302
303(ert-deftest subr-tests--gensym ()
304 "Test `gensym' behavior."
305 (should (equal (symbol-name (let ((gensym-counter 0)) (gensym)))
306 "g0"))
307 (should (eq (string-to-char (symbol-name (gensym))) ?g))
308 (should (eq (string-to-char (symbol-name (gensym "X"))) ?X)))
303 309
304(provide 'subr-tests) 310(provide 'subr-tests)
305;;; subr-tests.el ends here 311;;; subr-tests.el ends here
diff --git a/test/lisp/textmodes/css-mode-tests.el b/test/lisp/textmodes/css-mode-tests.el
index f93fdbbc5af..47cf5f9244b 100644
--- a/test/lisp/textmodes/css-mode-tests.el
+++ b/test/lisp/textmodes/css-mode-tests.el
@@ -80,6 +80,27 @@
80 (equal (seq-sort #'string-lessp (css--value-class-lookup 'position)) 80 (equal (seq-sort #'string-lessp (css--value-class-lookup 'position))
81 '("bottom" "calc()" "center" "left" "right" "top")))) 81 '("bottom" "calc()" "center" "left" "right" "top"))))
82 82
83(ert-deftest css-test-current-defun-name ()
84 (with-temp-buffer
85 (insert "body { top: 0; }")
86 (goto-char 7)
87 (should (equal (css-current-defun-name) "body"))
88 (goto-char 18)
89 (should (equal (css-current-defun-name) "body"))))
90
91(ert-deftest css-test-current-defun-name-nested ()
92 (with-temp-buffer
93 (insert "body > .main a { top: 0; }")
94 (goto-char 20)
95 (should (equal (css-current-defun-name) "body > .main a"))))
96
97(ert-deftest css-test-current-defun-name-complex ()
98 (with-temp-buffer
99 (insert "input[type=submit]:hover { color: red; }")
100 (goto-char 30)
101 (should (equal (css-current-defun-name)
102 "input[type=submit]:hover"))))
103
83;;; Completion 104;;; Completion
84 105
85(defun css-mode-tests--completions () 106(defun css-mode-tests--completions ()
diff --git a/test/lisp/vc/smerge-mode-tests.el b/test/lisp/vc/smerge-mode-tests.el
new file mode 100644
index 00000000000..10d090632da
--- /dev/null
+++ b/test/lisp/vc/smerge-mode-tests.el
@@ -0,0 +1,34 @@
1;; Copyright (C) 2017 Free Software Foundation, Inc
2
3;; Maintainer: emacs-devel@gnu.org
4
5;; This file is part of GNU Emacs.
6
7;; GNU Emacs is free software: you can redistribute it and/or modify
8;; it under the terms of the GNU General Public License as published by
9;; the Free Software Foundation, either version 3 of the License, or
10;; (at your option) any later version.
11
12;; GNU Emacs is distributed in the hope that it will be useful,
13;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;; GNU General Public License for more details.
16
17;; You should have received a copy of the GNU General Public License
18;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
19
20;;; Code:
21
22(require 'smerge-mode)
23
24(ert-deftest smerge-mode-test-empty-hunk ()
25 "Regression test for bug #25555"
26 (with-temp-buffer
27 (insert "<<<<<<< one\n")
28 (save-excursion
29 (insert "=======\nLLL\n>>>>>>> end\n"))
30 (smerge-mode)
31 (smerge-keep-current)
32 (should (equal (buffer-substring (point-min) (point-max)) ""))))
33
34(provide 'smerge-mode-tests)
diff --git a/test/lisp/xdg-tests.el b/test/lisp/xdg-tests.el
index e3c9a743e44..b80f5e85524 100644
--- a/test/lisp/xdg-tests.el
+++ b/test/lisp/xdg-tests.el
@@ -42,9 +42,6 @@
42 (should (equal "frobnicate" (gethash "Exec" tab2)))) 42 (should (equal "frobnicate" (gethash "Exec" tab2))))
43 (should-error 43 (should-error
44 (xdg-desktop-read-file 44 (xdg-desktop-read-file
45 (expand-file-name "wrong.desktop" xdg-tests-data-dir)))
46 (should-error
47 (xdg-desktop-read-file
48 (expand-file-name "malformed.desktop" xdg-tests-data-dir))) 45 (expand-file-name "malformed.desktop" xdg-tests-data-dir)))
49 (let ((tab (xdg-desktop-read-file 46 (let ((tab (xdg-desktop-read-file
50 (expand-file-name "l10n.desktop" xdg-tests-data-dir))) 47 (expand-file-name "l10n.desktop" xdg-tests-data-dir)))
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index 5dc26348a6f..8de8c145d40 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -101,7 +101,11 @@
101 (should (= 3 (apply #'min '(3 8 3)))) 101 (should (= 3 (apply #'min '(3 8 3))))
102 (should-error (min 9 8 'foo)) 102 (should-error (min 9 8 'foo))
103 (should-error (min (make-marker))) 103 (should-error (min (make-marker)))
104 (should (eql 1 (min (point-min-marker) 1)))) 104 (should (eql 1 (min (point-min-marker) 1)))
105 (should (isnan (min 0.0e+NaN)))
106 (should (isnan (min 0.0e+NaN 1 2)))
107 (should (isnan (min 1.0 0.0e+NaN)))
108 (should (isnan (min 1.0 0.0e+NaN 1.1))))
105 109
106;; Bool vector tests. Compactly represent bool vectors as hex 110;; Bool vector tests. Compactly represent bool vectors as hex
107;; strings. 111;; strings.
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index 1c3fde888f6..70dc9372fad 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -166,6 +166,14 @@
166 (should (string-equal 166 (should (string-equal
167 (format-time-string format look '(-28800 "PST")) 167 (format-time-string format look '(-28800 "PST"))
168 "1972-06-30 15:59:59.999 -0800 (PST)")) 168 "1972-06-30 15:59:59.999 -0800 (PST)"))
169 ;; Negative UTC offset, as a Lisp integer.
170 (should (string-equal
171 (format-time-string format look -28800)
172 ;; MS-Windows build replaces unrecognizable TZ values,
173 ;; such as "-08", with "ZZZ".
174 (if (eq system-type 'windows-nt)
175 "1972-06-30 15:59:59.999 -0800 (ZZZ)"
176 "1972-06-30 15:59:59.999 -0800 (-08)")))
169 ;; Positive UTC offset that is not an hour multiple, as a string. 177 ;; Positive UTC offset that is not an hour multiple, as a string.
170 (should (string-equal 178 (should (string-equal
171 (format-time-string format look "IST-5:30") 179 (format-time-string format look "IST-5:30")
diff --git a/test/src/fileio-tests.el b/test/src/fileio-tests.el
index a56fb4474d6..01c280d2752 100644
--- a/test/src/fileio-tests.el
+++ b/test/src/fileio-tests.el
@@ -35,6 +35,8 @@
35 (char 0)) 35 (char 0))
36 (while (and (not failure) (< char 127)) 36 (while (and (not failure) (< char 127))
37 (setq char (1+ char)) 37 (setq char (1+ char))
38 (when (and (eq system-type 'cygwin) (eq char 92))
39 (setq char (1+ char)))
38 (setq failure (try-link (string char) link))) 40 (setq failure (try-link (string char) link)))
39 (or failure 41 (or failure
40 (try-link "/:" link))) 42 (try-link "/:" link)))
diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el
index e176cff2dc6..d6d1d16b9ad 100644
--- a/test/src/lcms-tests.el
+++ b/test/src/lcms-tests.el
@@ -1,6 +1,6 @@
1;;; lcms-tests.el --- tests for Little CMS interface -*- lexical-binding: t -*- 1;;; lcms-tests.el --- tests for Little CMS interface -*- lexical-binding: t -*-
2 2
3;; Copyright (C) 2017 Free Software Foundation, Inc. 3;; Copyright (C) 2017 Free Software Foundation, Inc.
4 4
5;; Maintainer: emacs-devel@gnu.org 5;; Maintainer: emacs-devel@gnu.org
6 6
@@ -21,9 +21,11 @@
21 21
22;;; Commentary: 22;;; Commentary:
23 23
24;; Some "exact" values computed using the colorspacious python library 24;; Some reference values computed using the colorspacious python
25;; written by Nathaniel J. Smith. See 25;; library, assimilated from its test suite, or adopted from its
26;; https://colorspacious.readthedocs.io/en/v1.1.0/ 26;; aggregation of gold values.
27;; See https://colorspacious.readthedocs.io/en/v1.1.0/ and
28;; https://github.com/njsmith/colorspacious
27 29
28;; Other references: 30;; Other references:
29;; http://www.babelcolor.com/index_htm_files/A%20review%20of%20RGB%20color%20spaces.pdf 31;; http://www.babelcolor.com/index_htm_files/A%20review%20of%20RGB%20color%20spaces.pdf
@@ -49,14 +51,20 @@ B is considered the exact value."
49 (lcms-approx-p a2 b2 delta) 51 (lcms-approx-p a2 b2 delta)
50 (lcms-approx-p a3 b3 delta)))) 52 (lcms-approx-p a3 b3 delta))))
51 53
54(defun lcms-rgb255->xyz (rgb)
55 "Return XYZ tristimulus values corresponding to RGB."
56 (let ((rgb1 (mapcar (lambda (x) (/ x 255.0)) rgb)))
57 (apply #'color-srgb-to-xyz rgb1)))
58
52(ert-deftest lcms-cri-cam02-ucs () 59(ert-deftest lcms-cri-cam02-ucs ()
53 "Test use of `lcms-cam02-ucs'." 60 "Test use of `lcms-cam02-ucs'."
61 (skip-unless (featurep 'lcms2))
54 (should-error (lcms-cam02-ucs '(0 0 0) '(0 0 0) "error")) 62 (should-error (lcms-cam02-ucs '(0 0 0) '(0 0 0) "error"))
55 (should-error (lcms-cam02-ucs '(0 0 0) 'error)) 63 (should-error (lcms-cam02-ucs '(0 0 0) 'error))
56 (should-not 64 (should-not
57 (lcms-approx-p 65 (lcms-approx-p
58 (let ((lcms-d65-xyz '(0.44757 1.0 0.40745))) 66 (let ((wp '(0.44757 1.0 0.40745)))
59 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0))) 67 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0) wp))
60 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0)))) 68 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0 0 0))))
61 (should (eql 0.0 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0.5 0.5 0.5)))) 69 (should (eql 0.0 (lcms-cam02-ucs '(0.5 0.5 0.5) '(0.5 0.5 0.5))))
62 (should 70 (should
@@ -67,6 +75,7 @@ B is considered the exact value."
67 75
68(ert-deftest lcms-whitepoint () 76(ert-deftest lcms-whitepoint ()
69 "Test use of `lcms-temp->white-point'." 77 "Test use of `lcms-temp->white-point'."
78 (skip-unless (featurep 'lcms2))
70 (should-error (lcms-temp->white-point 3999)) 79 (should-error (lcms-temp->white-point 3999))
71 (should-error (lcms-temp->white-point 25001)) 80 (should-error (lcms-temp->white-point 25001))
72 ;; D55 81 ;; D55
@@ -85,4 +94,24 @@ B is considered the exact value."
85 (apply #'color-xyz-to-xyy (lcms-temp->white-point 7504)) 94 (apply #'color-xyz-to-xyy (lcms-temp->white-point 7504))
86 '(0.29902 0.31485 1.0)))) 95 '(0.29902 0.31485 1.0))))
87 96
97(ert-deftest lcms-dE-cam02-ucs-silver ()
98 "Test CRI-CAM02-UCS deltaE metric values from colorspacious."
99 (skip-unless (featurep 'lcms2))
100 (should
101 (lcms-approx-p
102 (lcms-cam02-ucs (lcms-rgb255->xyz '(173 52 52))
103 (lcms-rgb255->xyz '(59 120 51))
104 lcms-colorspacious-d65
105 (list 20 (/ 64 float-pi 5) 1 1))
106 44.698469808449964
107 0.03))
108 (should
109 (lcms-approx-p
110 (lcms-cam02-ucs (lcms-rgb255->xyz '(69 100 52))
111 (lcms-rgb255->xyz '(59 120 51))
112 lcms-colorspacious-d65
113 (list 20 (/ 64 float-pi 5) 1 1))
114 8.503323264883667
115 0.04)))
116
88;;; lcms-tests.el ends here 117;;; lcms-tests.el ends here