diff options
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 | ||
| 7846 | 2016-02-20 Lars Ingebrigtsen <larsi@gnus.org> | 7846 | 2016-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 | ||
| 12954 | 2016-04-29 Lars Ingebrigtsen <larsi@gnus.org> | 12954 | 2016-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 | ||
| 13165 | 2016-04-27 Lars Ingebrigtsen <larsi@gnus.org> | 13165 | 2016-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 | ||
| 5 | timestamp='2017-08-08' | 5 | timestamp='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 | |||
| 1435 | operating system you are using. If your script is old, overwrite *all* | 1407 | operating system you are using. If your script is old, overwrite *all* |
| 1436 | copies of config.guess and config.sub with the latest versions from: | 1408 | copies 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 |
| 1439 | and | 1411 | and |
| 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 | ||
| 1442 | If $0 has already been updated, send the following data and any | 1414 | If $0 has already been updated, send the following data and any |
| 1443 | information you think might be pertinent to config-patches@gnu.org to | 1415 | information 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 | ||
| 5 | timestamp='2017-04-02' | 5 | timestamp='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 | |||
| 1366 | if [ x"$os" != x"" ] | 1366 | if [ x"$os" != x"" ] |
| 1367 | then | 1367 | then |
| 1368 | case $os in | 1368 | case $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/ |
| 37 | END { | 37 | END { |
| 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 |
| 97 | The @code{timer-list} command was removed, as we decided timers are | 97 | The @code{list-timers} command was removed, as we decided timers are |
| 98 | not user-level feature, and therefore users should not be allowed to | 98 | not user-level feature, and therefore users should not be allowed to |
| 99 | mess with them. Ask an Emacs Lisp guru near you for help if you have | 99 | mess with them. Ask an Emacs Lisp guru near you for help if you have |
| 100 | a runaway timer in your session. (Of course, as you move back in | 100 | a 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 |
| 95 | Visit @var{file} using @code{find-file}. @xref{Visiting}. | 95 | Visit the specified @var{file}. @xref{Visiting}. |
| 96 | 96 | ||
| 97 | When Emacs starts up, it displays the startup buffer in one window, | 97 | When Emacs starts up, it displays the startup buffer in one window, |
| 98 | and the buffer visiting @var{file} in another window | 98 | and 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} |
| 114 | Visit @var{file} using @code{find-file}, then go to line number | 114 | Visit the specified @var{file}, then go to line number @var{linenum} |
| 115 | @var{linenum} in it. | 115 | in it. |
| 116 | 116 | ||
| 117 | @item +@var{linenum}:@var{columnnum} @var{file} | 117 | @item +@var{linenum}:@var{columnnum} @var{file} |
| 118 | Visit @var{file} using @code{find-file}, then go to line number | 118 | Visit the specified @var{file}, then go to line number @var{linenum} |
| 119 | @var{linenum} and put point at column number @var{columnnum}. | 119 | and 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 | |||
| 1745 | one screen line will be numbered that many times. The displayed | 1745 | one screen line will be numbered that many times. The displayed |
| 1746 | numbers are relative, as with @code{relative} value above. This is | 1746 | numbers are relative, as with @code{relative} value above. This is |
| 1747 | handy in modes that fold text, such as Outline mode (@pxref{Outline | 1747 | handy in modes that fold text, such as Outline mode (@pxref{Outline |
| 1748 | Mode}), and need to move by exact number of screen lines. | 1748 | Mode}), and when you need to move by exact number of screen lines. |
| 1749 | 1749 | ||
| 1750 | @item anything else | 1750 | @item anything else |
| 1751 | Any other non-@code{nil} value is treated as @code{t}. | 1751 | Any 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 |
| 1757 | A convenient way of turning on display of line numbers is @w{@kbd{M-x | 1757 | A convenient way of turning on display of line numbers is @w{@kbd{M-x |
| 1758 | display-line-numbers-mode @key{RET}}}. This mode has a globalized | 1758 | display-line-numbers-mode @key{RET}}}. This mode has a globalized |
| 1759 | variant, @code{global-display-line0numbers-mode}. The user option | 1759 | variant, @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 |
| 1761 | line-number display, described above, will these modes activate. | 1761 | line-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} | |||
| 1778 | value, line numbers will disregard any narrowing and will start at the | 1778 | value, line numbers will disregard any narrowing and will start at the |
| 1779 | first character of the buffer. | 1779 | first 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 | ||
| 1784 | In selective display mode (@pxref{Selective Display}), and other modes | ||
| 1785 | that hide many lines from display (such as Outline and Org modes), you | ||
| 1786 | may 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 | ||
| 1790 | occasional miscalculations of space reserved for the line numbers. | ||
| 1791 | |||
| 1781 | @cindex line-number face | 1792 | @cindex line-number face |
| 1782 | The line numbers are displayed in a special face @code{line-number}. | 1793 | The line numbers are displayed in a special face @code{line-number}. |
| 1783 | The current line number is displayed in a different face, | 1794 | The 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 |
| 1091 | This variable, if non-@code{nil} in a particular buffer, tells | 1091 | This 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 |
| 1093 | second optional argument to that function is @code{t}) to offer to | 1093 | it offers to save file-visiting buffers. If @code{save-some-buffers} |
| 1094 | save that buffer, just as they offer to save file-visiting buffers. | 1094 | is called with the second optional argument set to @code{t}, it will |
| 1095 | @xref{Definition of save-some-buffers}. The variable | 1095 | also offer to save the buffer. Lastly, if this variable is set to the |
| 1096 | @code{buffer-offer-save} automatically becomes buffer-local when set | 1096 | symbol @code{always}, both @code{save-buffers-kill-emacs} and |
| 1097 | for any reason. @xref{Buffer-Local Variables}. | 1097 | @code{save-some-buffers} will always offer to save. @xref{Definition |
| 1098 | of save-some-buffers}. The variable @code{buffer-offer-save} | ||
| 1099 | automatically 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}. | |||
| 332 | that is visiting that file---that is, the contents of the file are | 332 | that is visiting that file---that is, the contents of the file are |
| 333 | copied into the buffer and the copy is what you edit. Changes to the | 333 | copied into the buffer and the copy is what you edit. Changes to the |
| 334 | buffer do not change the file until you @dfn{save} the buffer, which | 334 | buffer do not change the file until you @dfn{save} the buffer, which |
| 335 | means copying the contents of the buffer into the file. | 335 | means copying the contents of the buffer into the file. Buffers which |
| 336 | are not visiting a file can still be ``saved'', in a sense, using | ||
| 337 | functions 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 |
| 338 | This function saves the contents of the current buffer in its visited | 340 | This 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} |
| 366 | This command saves some modified file-visiting buffers. Normally it | 368 | This command saves some modified file-visiting buffers. Normally it |
| 367 | asks the user about each buffer. But if @var{save-silently-p} is | 369 | asks the user about each buffer. But if @var{save-silently-p} is |
| 368 | non-@code{nil}, it saves all the file-visiting buffers without querying | 370 | non-@code{nil}, it saves all the file-visiting buffers without |
| 369 | the user. | 371 | querying the user. |
| 370 | 372 | ||
| 371 | @vindex save-some-buffers-default-predicate | 373 | @vindex save-some-buffers-default-predicate |
| 372 | The optional @var{pred} argument provides a predicate that controls | 374 | The 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 | ||
| 119 | To create a new frame, call the function @code{make-frame}. | 120 | To 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 |
| 122 | This function creates and returns a new frame, displaying the current | 123 | This function creates and returns a new frame, displaying the current |
| 123 | buffer. | 124 | buffer. |
| 124 | 125 | ||
| 125 | The @var{alist} argument is an alist that specifies frame parameters | 126 | The @var{parameters} argument is an alist that specifies frame |
| 126 | for the new frame. @xref{Frame Parameters}. If you specify the | 127 | parameters for the new frame. @xref{Frame Parameters}. If you specify |
| 127 | @code{terminal} parameter in @var{alist}, the new frame is created on | 128 | the @code{terminal} parameter in @var{parameters}, the new frame is |
| 128 | that terminal. Otherwise, if you specify the @code{window-system} | 129 | created on that terminal. Otherwise, if you specify the |
| 129 | frame parameter in @var{alist}, that determines whether the frame | 130 | @code{window-system} frame parameter in @var{parameters}, that |
| 130 | should be displayed on a text terminal or a graphical terminal. | 131 | determines whether the frame should be displayed on a text terminal or a |
| 131 | @xref{Window Systems}. If neither is specified, the new frame is | 132 | graphical terminal. @xref{Window Systems}. If neither is specified, |
| 132 | created in the same terminal as the selected frame. | 133 | the new frame is created in the same terminal as the selected frame. |
| 133 | 134 | ||
| 134 | Any parameters not mentioned in @var{alist} default to the values in | 135 | Any parameters not mentioned in @var{parameters} default to the values |
| 135 | the alist @code{default-frame-alist} (@pxref{Initial Parameters}); | 136 | in the alist @code{default-frame-alist} (@pxref{Initial Parameters}); |
| 136 | parameters not specified there default from the X resources or its | 137 | parameters not specified there default from the X resources or its |
| 137 | equivalent on your operating system (@pxref{X Resources,, X Resources, | 138 | equivalent on your operating system (@pxref{X Resources,, X Resources, |
| 138 | emacs, The GNU Emacs Manual}). After the frame is created, Emacs | 139 | emacs, The GNU Emacs Manual}). After the frame is created, this |
| 139 | applies any parameters listed in @code{frame-inherited-parameters} | 140 | function 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, |
| 141 | the frame that was selected when @code{make-frame} was called. | 142 | taking the values from the frame that was selected when |
| 143 | @code{make-frame} was called. | ||
| 142 | 144 | ||
| 143 | Note that on multi-monitor displays (@pxref{Multiple Terminals}), the | 145 | Note that on multi-monitor displays (@pxref{Multiple Terminals}), the |
| 144 | window manager might position the frame differently than specified by | 146 | window manager might position the frame differently than specified by |
| 145 | the positional parameters in @var{alist} (@pxref{Position | 147 | the positional parameters in @var{parameters} (@pxref{Position |
| 146 | Parameters}). For example, some window managers have a policy of | 148 | Parameters}). For example, some window managers have a policy of |
| 147 | displaying the frame on the monitor that contains the largest part of | 149 | displaying the frame on the monitor that contains the largest part of |
| 148 | the window (a.k.a.@: the @dfn{dominating} monitor). | 150 | the 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 |
| 161 | An abnormal hook run by @code{make-frame} after it creates the frame. | 163 | An abnormal hook run by @code{make-frame} after it created the frame. |
| 162 | Each function in @code{after-make-frame-functions} receives one argument, the | 164 | Each function in @code{after-make-frame-functions} receives one |
| 163 | frame just created. | 165 | argument, the frame just created. |
| 164 | @end defvar | 166 | @end defvar |
| 165 | 167 | ||
| 168 | Note that any functions added to these hooks by your initial file are | ||
| 169 | usually not run for the initial frame, since Emacs reads the initial | ||
| 170 | file only after creating that frame. However, if the initial frame is | ||
| 171 | specified to use a separate minibuffer frame (@pxref{Minibuffers and | ||
| 172 | Frames}), the functions will be run for both, the minibuffer-less and | ||
| 173 | the minibuffer frame. | ||
| 174 | |||
| 166 | @defvar frame-inherited-parameters | 175 | @defvar frame-inherited-parameters |
| 167 | This variable specifies the list of frame parameters that a newly | 176 | This variable specifies the list of frame parameters that a newly |
| 168 | created frame inherits from the currently selected frame. For each | 177 | created frame inherits from the currently selected frame. For each |
| 169 | parameter (a symbol) that is an element in the list and is not present | 178 | parameter (a symbol) that is an element in this list and has not been |
| 170 | in the argument to @code{make-frame}, the function sets the value of | 179 | assigned earlier when processing @code{make-frame}, the function sets |
| 171 | that parameter in the created frame to its value in the selected | 180 | the value of that parameter in the created frame to its value in the |
| 172 | frame. | 181 | selected 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 | |||
| 1885 | cause anything special to happen. | 1885 | cause anything special to happen. |
| 1886 | @end defun | 1886 | @end defun |
| 1887 | 1887 | ||
| 1888 | @findex timer-list | 1888 | @findex list-timers |
| 1889 | The @code{timer-list} command lists all the currently active timers. | 1889 | The @code{list-timers} command lists all the currently active timers. |
| 1890 | There's only one command available in the buffer displayed: @kbd{c} | 1890 | There'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 |
| 1892 | under point. | 1892 | under 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 | ||
| 829 | This function acts like @code{format}, except it also converts any | 830 | This function acts like @code{format}, except it also converts any |
| 830 | grave accents (@t{`}) and apostrophes (@t{'}) in @var{string} as per the | 831 | grave accents (@t{`}) and apostrophes (@t{'}) in @var{string} as per the |
| 831 | value of @code{text-quoting-style}. | 832 | value 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 | |||
| 4328 | all markers unrelocated. | 4330 | all 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 | ||
| 4337 | with the text of another buffer: | ||
| 4338 | |||
| 4339 | @deffn Command replace-buffer-contents source | ||
| 4340 | This function replaces the accessible portion of the current buffer | ||
| 4341 | with the accessible portion of the buffer @var{source}. @var{source} | ||
| 4342 | may either be a buffer object or the name of a buffer. When | ||
| 4343 | @code{replace-buffer-contents} succeeds, the text of the accessible | ||
| 4344 | portion of the current buffer will be equal to the text of the | ||
| 4345 | accessible portion of the @var{source} buffer. This function attempts | ||
| 4346 | to keep point, markers, text properties, and overlays in the current | ||
| 4347 | buffer intact. One potential case where this behavior is useful is | ||
| 4348 | external code formatting programs: they typically write the | ||
| 4349 | reformatted text into a temporary buffer or file, and using | ||
| 4350 | @code{delete-region} and @code{insert-buffer-substring} would destroy | ||
| 4351 | these properties. However, the latter combination is typically | ||
| 4352 | faster. @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 | |||
| 68 | not meant to be used by other packages. | 68 | not meant to be used by other packages. |
| 69 | 69 | ||
| 70 | Occasionally, for a command name intended for users to use, it is more | 70 | Occasionally, for a command name intended for users to use, it is more |
| 71 | convenient if some words come before the package's name prefix. And | 71 | convenient if some words come before the package's name prefix. For |
| 72 | constructs that define functions, variables, etc., work better if they | 72 | example, it is our convention to have commands that list objects named |
| 73 | start with @samp{defun} or @samp{defvar}, so put the name prefix later | 73 | as @samp{list-@var{something}}, e.g., a package called @samp{frob} |
| 74 | on in the name. | 74 | could have a command @samp{list-frobs}, when its other global symbols |
| 75 | begin with @samp{frob-}. Also, constructs that define functions, | ||
| 76 | variables, 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 | ||
| 76 | This recommendation applies even to names for traditional Lisp | 79 | This recommendation applies even to names for traditional Lisp |
| 77 | primitives that are not primitives in Emacs Lisp---such as | 80 | primitives 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 | ||
| 3046 | If this is too radical, because you want to use version control | ||
| 3047 | remotely, trim @code{vc-handled-backends} to just those you care | ||
| 3048 | about, for example: | ||
| 3049 | |||
| 3050 | @lisp | ||
| 3051 | (setq vc-handled-backends '(SVN Git)) | ||
| 3052 | @end lisp | ||
| 3053 | |||
| 3046 | Disable excessive traces. Set @code{tramp-verbose} to 3 or lower, | 3054 | Disable excessive traces. Set @code{tramp-verbose} to 3 or lower, |
| 3047 | default being 3. Increase trace levels temporarily when hunting for | 3055 | default being 3. Increase trace levels temporarily when hunting for |
| 3048 | bugs. | 3056 | bugs. |
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 |
| @@ -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 |
| 145 | visiting a file would always prompt for a file name. Now it only does | 150 | visiting a file would always prompt for a file name. Now it only does |
| 146 | so if 'write-contents-functions' is nil (or all its functions return | 151 | so if 'write-contents-functions' is nil (or all its functions return |
| 147 | nil). A non-nil buffer-local value for this variable is sufficient | 152 | nil). |
| 148 | for '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. | |||
| 367 | puny.el library, so that one can visit Web sites with non-ASCII URLs. | 371 | puny.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, |
| 371 | where you can cancel them with the 'c' command. | 375 | where 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, | |||
| 578 | defun are selected unless they are separated from the defun by a blank | 582 | defun are selected unless they are separated from the defun by a blank |
| 579 | line. | 583 | line. |
| 580 | 584 | ||
| 581 | --- | ||
| 582 | ** New command 'replace-buffer-contents'. | 585 | ** New command 'replace-buffer-contents'. |
| 583 | This command replaces the contents of the accessible portion of the | 586 | This command replaces the contents of the accessible portion of the |
| 584 | current buffer with the contents of the accessible portion of a | 587 | current 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 |
| 702 | added: 'C-c C-s C-m C-m'. | 705 | added: '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 | ||
| 710 | instead of the numeric form. The %z format continues to be the | ||
| 711 | numeric 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 | |||
| 1344 | priority instead. Now the code does what the documentation says it | 1353 | priority instead. Now the code does what the documentation says it |
| 1345 | should do. | 1354 | should do. |
| 1346 | 1355 | ||
| 1356 | --- | ||
| 1357 | ** 'eldoc-message' only accepts one argument now. Programs that | ||
| 1358 | called it with multiple arguments before should pass them through | ||
| 1359 | 'format' first. Even that is discouraged: for ElDoc support, you | ||
| 1360 | should 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. |
| 1814 | For details, see the doc string of 'rx--pcase-macroexpander'. | 1829 | For details, see the doc string of 'rx--pcase-macroexpander'. |
| 1815 | 1830 | ||
| 1831 | --- | ||
| 1832 | ** New functions to set region from secondary selection and vice versa. | ||
| 1833 | The new functions 'secondary-selection-to-region' and | ||
| 1834 | 'secondary-selection-from-region' let you set the beginning and the | ||
| 1835 | end of the region from those of the secondary selection and vise | ||
| 1836 | versa. | ||
| 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 | ||
| 1903 | like the macOS default. The new variables 'ns-mwheel-line-height', | ||
| 1904 | 'ns-use-mwheel-acceleration' and 'ns-use-mwheel-momentum' can be used | ||
| 1905 | to customize the behavior. | ||
| 1906 | |||
| 1879 | 1907 | ||
| 1880 | ---------------------------------------------------------------------- | 1908 | ---------------------------------------------------------------------- |
| 1881 | This file is part of GNU Emacs. | 1909 | This 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 | |||
| 70 | COUNT_LEADING_ZEROS_INLINE int | 70 | COUNT_LEADING_ZEROS_INLINE int |
| 71 | count_leading_zeros_32 (unsigned int x) | 71 | count_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 | |||
| 68 | COUNT_TRAILING_ZEROS_INLINE int | 68 | COUNT_TRAILING_ZEROS_INLINE int |
| 69 | count_trailing_zeros_32 (unsigned int x) | 69 | count_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 */ |
| 83 | static int _GL_ATTRIBUTE_PURE | 83 | static int _GL_ATTRIBUTE_PURE |
| 84 | verrevcmp (const char *s1, size_t s1_len, const char *s2, size_t s2_len) | 84 | verrevcmp (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@ | |||
| 558 | LIBHESIOD = @LIBHESIOD@ | 558 | LIBHESIOD = @LIBHESIOD@ |
| 559 | LIBINTL = @LIBINTL@ | 559 | LIBINTL = @LIBINTL@ |
| 560 | LIBJPEG = @LIBJPEG@ | 560 | LIBJPEG = @LIBJPEG@ |
| 561 | LIBLCMS2 = @LIBLCMS2@ | ||
| 561 | LIBMODULES = @LIBMODULES@ | 562 | LIBMODULES = @LIBMODULES@ |
| 562 | LIBOBJS = @LIBOBJS@ | 563 | LIBOBJS = @LIBOBJS@ |
| 563 | LIBOTF_CFLAGS = @LIBOTF_CFLAGS@ | 564 | LIBOTF_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 |
| 267 | no option is passed to the class. | 267 | no option is passed to the class. |
| 268 | 268 | ||
| 269 | Insert the \"\\usepacakge{geometry}\" directive when ARGS | 269 | Insert the \"\\usepackage{geometry}\" directive when ARGS |
| 270 | contains the \"landscape\" string." | 270 | contains 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 | ||
| 291 | Capture all messages produced by `message' when it is called from | 291 | Capture messages issued by Lisp code and concatenate them |
| 292 | Lisp, and concatenate them separated by newlines into one string. | 292 | separated by newlines into one string. This includes messages |
| 293 | written by `message' as well as objects printed by `print', | ||
| 294 | `prin1' and `princ' to the echo area. Messages issued from C | ||
| 295 | code using the above mentioned functions will not be captured. | ||
| 293 | 296 | ||
| 294 | This is useful for separating the issuance of messages by the | 297 | This is useful for separating the issuance of messages by the |
| 295 | code under test from the behavior of the *Messages* buffer." | 298 | code 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'. | ||
| 321 | COLLECTOR will be called with the message before it is passed | ||
| 322 | to 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'. | ||
| 332 | The created advice function will just call the original function | ||
| 333 | unless the output is going to the echo area (when PRINTCHARFUN is | ||
| 334 | t or PRINTCHARFUN is nil and `standard-output' is t). If the | ||
| 335 | output is destined for the echo area, the advice function will | ||
| 336 | convert 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 | |||
| 128 | returned, or the last form in ELSE is returned. | 128 | returned, or the last form in ELSE is returned. |
| 129 | 129 | ||
| 130 | Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds | 130 | Each element of VARLIST is a list (SYMBOL VALUEFORM) which binds |
| 131 | SYMBOL to the value of VALUEFORM). An element can additionally | 131 | SYMBOL to the value of VALUEFORM. An element can additionally |
| 132 | be of the form (VALUEFORM), which is evaluated and checked for | 132 | be of the form (VALUEFORM), which is evaluated and checked for |
| 133 | nil; i.e. SYMBOL can be omitted if only the test result is of | 133 | nil; i.e. SYMBOL can be omitted if only the test result is of |
| 134 | interest." | 134 | interest." |
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 | |||
| 381 | point (where the PPSS is equivalent to nil).") | 381 | point (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). | ||
| 395 | Where LAST is a pair (LAST-POS . LAST-PPS) caching the last invocation | ||
| 396 | and CACHE is a list of (POS . PPSS) pairs, in decreasing POS order. | ||
| 397 | These 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. |
| 428 | The returned value is the same as that of `parse-partial-sexp' | 460 | The 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'. |
| 144 | Otherwise, evaluates FORM with no error handling." | 144 | Otherwise, 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. |
| 152 | Do so even if the buffer is not visiting a file. | 152 | Do so even if the buffer is not visiting a file. |
| 153 | Automatically local in all buffers." | 153 | Automatically local in all buffers. |
| 154 | :type 'boolean | 154 | |
| 155 | Set 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. |
| 611 | The functions are run with one arg, the newly created frame.") | 611 | The functions are run with one argument, the newly created |
| 612 | frame.") | ||
| 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 | ||
| 635 | You cannot specify either `width' or `height', you must specify | ||
| 636 | neither 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. | |||
| 650 | In addition, any parameter specified in `default-frame-alist', | 648 | In addition, any parameter specified in `default-frame-alist', |
| 651 | but not present in PARAMETERS, is applied. | 649 | but not present in PARAMETERS, is applied. |
| 652 | 650 | ||
| 653 | Before creating the frame (via `frame-creation-function-alist'), | 651 | Before creating the frame (via `frame-creation-function'), this |
| 654 | this function runs the hook `before-make-frame-hook'. After | 652 | function runs the hook `before-make-frame-hook'. After creating |
| 655 | creating the frame, it runs the hook `after-make-frame-functions' | 653 | the frame, it runs the hook `after-make-frame-functions' with one |
| 656 | with one arg, the newly created frame. | 654 | argument, the newly created frame. |
| 657 | 655 | ||
| 658 | If a display parameter is supplied and a window-system is not, | 656 | If a display parameter is supplied and a window-system is not, |
| 659 | guess the window-system from the display. | 657 | guess 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 | |||
| 638 | When switching from a GUI frame to a tty frame, behave | ||
| 639 | as `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. |
| 636 | This is used for positional parameters `left' and `top', which are | 647 | This 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 | ||
| 996 | All other format specifiers are passed to `format-time-string' | 995 | All other format specifiers are passed to `format-time-string' |
| 997 | which is called using the date from the article your replying to, but | 996 | which 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. | ||
| 1925 | This puts mark and point at the beginning and the end of the | ||
| 1926 | secondary selection, respectively. This works when the secondary | ||
| 1927 | selection exists and the region does not exist in current buffer; | ||
| 1928 | the secondary selection will be deleted afterward. | ||
| 1929 | If the region is active, or the secondary selection doesn't exist, | ||
| 1930 | this 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. | ||
| 1942 | When 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." | |||
| 163 | This is a string of ten letters or dashes as in ls -l." | 168 | This 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 | ||
| 614 | sub myrealpath { | 614 | sub 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 | ||
| 619 | sub recursive { | 619 | sub 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. |
| 1584 | Either the shares are listed, or the `dir' command is executed. | 1584 | Either the shares are listed, or the `dir' command is executed. |
| 1585 | Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." | 1585 | Result 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. | ||
| 87 | This is an alist with elements of the form: | ||
| 88 | REGEXP [INIT [CLEANUP [NAME]]] | ||
| 89 | REGEXP is a regular expression that matches a file name. | ||
| 90 | INIT is the init function to use, missing means disable `flymake-mode'. | ||
| 91 | CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'. | ||
| 92 | NAME 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. | ||
| 128 | Return nil if we cannot, non-nil if | ||
| 129 | we 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. | ||
| 153 | If 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. | ||
| 166 | Buildfile includes Makefile, build.xml etc. | ||
| 167 | Return 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. | ||
| 189 | Return 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 | |||
| 199 | Name is specified by FILE-NAME and location is specified by | ||
| 200 | MASTER-FILE-DIRS. Master files include .cpp and .c for .h. | ||
| 201 | Files are searched for starting from the .h directory and max | ||
| 202 | max-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. | ||
| 233 | This function is used in sort to move most possible file names | ||
| 234 | to 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. | ||
| 241 | Nil 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. | ||
| 249 | If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME | ||
| 250 | instead of SOURCE-FILE-NAME. | ||
| 251 | |||
| 252 | For example, foo.cpp is a master file if it includes foo.h. | ||
| 253 | |||
| 254 | When a buffer for MASTER-FILE-NAME exists, use it as a source | ||
| 255 | instead 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. | ||
| 343 | Return 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. | ||
| 357 | Return 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. | ||
| 364 | Find 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. | ||
| 398 | Create 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. | ||
| 405 | It'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. | ||
| 497 | If line-numbers is less than MIN-LINE, set line numbers to MIN-LINE. | ||
| 498 | If line numbers is greater than MAX-LINE, set line numbers to MAX-LINE. | ||
| 499 | The reason for this fix is because some compilers might report | ||
| 500 | line 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. | ||
| 540 | Return last one as residual if it does not end with newline char. | ||
| 541 | Returns ((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. | ||
| 553 | Convert 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). | ||
| 598 | Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns | ||
| 599 | from 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. | ||
| 604 | Takes a single argument, the error's text and should return non-nil | ||
| 605 | if it's a warning. | ||
| 606 | Instead 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. | ||
| 610 | Return 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'. | ||
| 864 | Delete 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. | ||
| 870 | Return 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. | ||
| 994 | Use 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. | ||
| 45 | The value may also be a list of two elements where the second | ||
| 46 | element specifies the face for the bitmap. For possible bitmap | ||
| 47 | symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. | ||
| 48 | |||
| 49 | The option `flymake-fringe-indicator-position' controls how and where | ||
| 50 | this 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. | ||
| 60 | The value may also be a list of two elements where the second | ||
| 61 | element specifies the face for the bitmap. For possible bitmap | ||
| 62 | symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. | ||
| 63 | |||
| 64 | The option `flymake-fringe-indicator-position' controls how and where | ||
| 65 | this 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. | ||
| 75 | The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. | ||
| 76 | See `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. | ||
| 113 | Value is an alist of conses (PREDICATE . CHECKER). Both PREDICATE | ||
| 114 | and CHECKER are functions called with a single argument, the | ||
| 115 | buffer in which `flymake-mode' was enabled. PREDICATE is expected | ||
| 116 | to (quickly) return t or nil if the buffer can be syntax checked | ||
| 117 | by CHECKER, which in can performs more morose operations, | ||
| 118 | possibly 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. | ||
| 142 | If LEVEL is higher than `flymake-log-level', the message is | ||
| 143 | ignored. Otherwise, it is printed using `message'. | ||
| 144 | TEXT is a format control string, and the remaining arguments ARGS | ||
| 145 | are 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. | ||
| 152 | POS 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. | ||
| 159 | POS 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. | ||
| 201 | Value 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. | ||
| 262 | Return 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. | ||
| 291 | Perhaps 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. | ||
| 332 | For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'. | ||
| 333 | The new element is inserted in the proper position, according to | ||
| 334 | the predicate `flymake-line-err-info-is-less-or-equal'. | ||
| 335 | The 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. | ||
| 348 | Returns the updated value of ERR-INFO-LIST. | ||
| 349 | For the format of ERR-INFO-LIST, see `flymake-err-info'. | ||
| 350 | For 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. | ||
| 48 | The value may also be a list of two elements where the second | ||
| 49 | element specifies the face for the bitmap. For possible bitmap | ||
| 50 | symbols, see `fringe-bitmaps'. See also `flymake-warning-bitmap'. | ||
| 51 | |||
| 52 | The option `flymake-fringe-indicator-position' controls how and where | ||
| 53 | this 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. | ||
| 63 | The value may also be a list of two elements where the second | ||
| 64 | element specifies the face for the bitmap. For possible bitmap | ||
| 65 | symbols, see `fringe-bitmaps'. See also `flymake-error-bitmap'. | ||
| 66 | |||
| 67 | The option `flymake-fringe-indicator-position' controls how and where | ||
| 68 | this 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. | ||
| 78 | The value can be nil (do not use indicators), `left-fringe' or `right-fringe'. | ||
| 79 | See `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. | ||
| 159 | This is an alist with elements of the form: | ||
| 160 | REGEXP INIT [CLEANUP [NAME]] | ||
| 161 | REGEXP is a regular expression that matches a file name. | ||
| 162 | INIT is the init function to use, missing means disable `flymake-mode'. | ||
| 163 | CLEANUP is the cleanup function to use, default `flymake-simple-cleanup'. | ||
| 164 | NAME 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. | ||
| 202 | If LEVEL is higher than `flymake-log-level', the message is | ||
| 203 | ignored. Otherwise, it is printed using `message'. | ||
| 204 | TEXT is a format control string, and the remaining arguments ARGS | ||
| 205 | are 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. | ||
| 212 | POS 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. | ||
| 219 | POS 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. | ||
| 245 | Return 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. | ||
| 268 | If 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. | ||
| 281 | Buildfile includes Makefile, build.xml etc. | ||
| 282 | Return 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. | ||
| 304 | Return 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 | |||
| 314 | Name is specified by FILE-NAME and location is specified by | ||
| 315 | MASTER-FILE-DIRS. Master files include .cpp and .c for .h. | ||
| 316 | Files are searched for starting from the .h directory and max | ||
| 317 | max-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. | ||
| 348 | This function is used in sort to move most possible file names | ||
| 349 | to 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. | ||
| 356 | Nil 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. | ||
| 364 | If yes, patch a copy of MASTER-FILE-NAME to include PATCHED-SOURCE-FILE-NAME | ||
| 365 | instead of SOURCE-FILE-NAME. | ||
| 366 | |||
| 367 | For example, foo.cpp is a master file if it includes foo.h. | ||
| 368 | |||
| 369 | When a buffer for MASTER-FILE-NAME exists, use it as a source | ||
| 370 | instead 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. | ||
| 458 | Return 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. | ||
| 472 | Return 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. | ||
| 479 | Find 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. | ||
| 513 | Create 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. | ||
| 520 | It'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. | ||
| 647 | Value 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. | ||
| 670 | If line-numbers is less than MIN-LINE, set line numbers to MIN-LINE. | ||
| 671 | If line numbers is greater than MAX-LINE, set line numbers to MAX-LINE. | ||
| 672 | The reason for this fix is because some compilers might report | ||
| 673 | line 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. | ||
| 728 | Return 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. | ||
| 757 | Perhaps 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. | ||
| 799 | Return last one as residual if it does not end with newline char. | ||
| 800 | Returns ((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. | ||
| 812 | Convert 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). | ||
| 857 | Use `flymake-reformat-err-line-patterns-from-compile-el' to add patterns | ||
| 858 | from 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. | ||
| 863 | Takes a single argument, the error's text and should return non-nil | ||
| 864 | if it's a warning. | ||
| 865 | Instead 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. | ||
| 869 | Return 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. | ||
| 928 | For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'. | ||
| 929 | The new element is inserted in the proper position, according to | ||
| 930 | the predicate `flymake-line-err-info-is-less-or-equal'. | ||
| 931 | The 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. | ||
| 944 | Returns the updated value of ERR-INFO-LIST. | ||
| 945 | For the format of ERR-INFO-LIST, see `flymake-err-info'. | ||
| 946 | For 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'. | ||
| 1424 | Delete 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. | ||
| 1430 | Return 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. | ||
| 1554 | Use 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). |
| 2493 | Indent as far as preceding non-empty line, then by steps of `sh-indentation'. | 2489 | Indent as far as preceding non-empty line, then by steps of `sh-basic-offset'. |
| 2494 | Lines containing only comments are considered empty." | 2490 | Lines 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 | ||
| 3593 | If `sh-use-smie' is non-nil, call `smie-config-guess'. | ||
| 3594 | Otherwise, run the sh-script specific indent learning command, as | ||
| 3595 | decribed below. | ||
| 3596 | |||
| 3597 | Output in buffer \"*indent*\" shows any lines which have conflicting | 3597 | Output in buffer \"*indent*\" shows any lines which have conflicting |
| 3598 | values of a variable, and the final value of all variables learned. | 3598 | values of a variable, and the final value of all variables learned. |
| 3599 | When called interactively, pop to this buffer automatically if | 3599 | When called interactively, pop to this buffer automatically if |
| @@ -3610,8 +3610,7 @@ to the value of variable `sh-learn-basic-offset'. | |||
| 3610 | 3610 | ||
| 3611 | Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the | 3611 | Abnormal hook `sh-learned-buffer-hook' if non-nil is called when the |
| 3612 | function completes. The function is abnormal because it is called | 3612 | function completes. The function is abnormal because it is called |
| 3613 | with an alist of variables learned. This feature may be changed or | 3613 | with an alist of variables learned. |
| 3614 | removed in the future. | ||
| 3615 | 3614 | ||
| 3616 | This command can often take a long time to run." | 3615 | This 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. |
| 42 | Also, a non-nil value set the point in the output buffer | 42 | Also, a non-nil value sets the point in the output buffer |
| 43 | once the command complete. | 43 | once the command completes. |
| 44 | The value `beg-last-out' set point at the beginning of the output, | 44 | The 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' |
| 46 | restore the buffer position before the command." | 46 | restores 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. |
| 57 | It is an alist (BUFFER . POS), where BUFFER is the output | 57 | It is an alist of (BUFFER . POS), where BUFFER is the output |
| 58 | buffer, and POS is the point position in BUFFER once the command finish. | 58 | buffer, and POS is the point position in BUFFER once the command finishes. |
| 59 | This variable is used when `shell-command-dont-erase-buffer' is non-nil.") | 59 | This 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. | |||
| 1010 | If METHOD is `delete-only', then delete the region; the return value | 1003 | If METHOD is `delete-only', then delete the region; the return value |
| 1011 | is undefined. If METHOD is nil, then return the content as a string. | 1004 | is undefined. If METHOD is nil, then return the content as a string. |
| 1012 | If METHOD is `bounds', then return the boundaries of the region | 1005 | If METHOD is `bounds', then return the boundaries of the region |
| 1013 | as a list of the form (START . END). | 1006 | as a list of pairs of (START . END) positions. |
| 1014 | If METHOD is anything else, delete the region and return its content | 1007 | If METHOD is anything else, delete the region and return its content |
| 1015 | as a string, after filtering it with `filter-buffer-substring', which | 1008 | as a string, after filtering it with `filter-buffer-substring', which |
| 1016 | is called with METHOD as its 3rd argument.") | 1009 | is 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. | |||
| 289 | PREFIX is a string, and defaults to \"g\"." | 289 | PREFIX 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. |
| 1271 | The return value is a positive integer." | 1271 | The 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. | ||
| 1276 | The 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. |
| 87 | If FILENAME has absolute path /foo/bar.jpg, its canonical URI is | 87 | If FILENAME has absolute file name /foo/bar.jpg, its canonical URI is |
| 88 | file:///foo/bar.jpg" | 88 | file:///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], | |||
| 44 | AC_DEFUN([gl_PREREQ_ALLOCA], [:]) | 44 | AC_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 | ||
| 49 | m4_version_prereq([2.69], [] ,[ | 49 | m4_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. |
| 239 | AC_DEFUN([gl_PROG_CC_C99], | 239 | AC_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 |
| 2 | dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. | 2 | dnl Copyright (C) 2008-2017 Free Software Foundation, Inc. |
| 3 | dnl This file is free software; the Free Software Foundation | 3 | dnl This file is free software; the Free Software Foundation |
| 4 | dnl gives unlimited permission to copy and/or distribute it, | 4 | dnl 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 | |||
| 369 | dnl _STDC_C99, which suppresses a bogus failure in <stdbool.h>. | 369 | dnl _STDC_C99, which suppresses a bogus failure in <stdbool.h>. |
| 370 | dnl The resulting compiler passes the test case here, and that's | 370 | dnl The resulting compiler passes the test case here, and that's |
| 371 | dnl good enough. For more, please see the thread starting at: | 371 | dnl good enough. For more, please see the thread starting at: |
| 372 | dnl http://lists.gnu.org/archive/html/autoconf/2010-12/msg00059.html | 372 | dnl https://lists.gnu.org/archive/html/autoconf/2010-12/msg00059.html |
| 373 | dnl Tru64 -c99 | 373 | dnl Tru64 -c99 |
| 374 | dnl with extended modes being tried first. | 374 | dnl 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>. |
| 462 | AU_DEFUN([AC_PROG_CC_C89], | 462 | AU_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], | |||
| 40 | m4_version_prereq([2.70], [], [ | 40 | m4_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 | ||
| 45 | m4_undefine([AC_HEADER_MAJOR]) | 45 | m4_undefine([AC_HEADER_MAJOR]) |
| 46 | AC_DEFUN([AC_HEADER_MAJOR], | 46 | AC_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. |
| 282 | W32_OBJ=@W32_OBJ@ | 282 | W32_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. |
| 285 | W32_LIBS=@W32_LIBS@ | 285 | W32_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 | |||
| 3010 | minmax_driver (ptrdiff_t nargs, Lisp_Object *args, | 3010 | minmax_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 * | |||
| 237 | XD_OBJECT_TO_STRING (Lisp_Object object) | 237 | XD_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, | |||
| 74 | static long int tm_gmtoff (struct tm *); | 74 | static long int tm_gmtoff (struct tm *); |
| 75 | static int tm_diff (struct tm *, struct tm *); | 75 | static int tm_diff (struct tm *, struct tm *); |
| 76 | static void update_buffer_properties (ptrdiff_t, ptrdiff_t); | 76 | static void update_buffer_properties (ptrdiff_t, ptrdiff_t); |
| 77 | static 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. | |||
| 4140 | usage: (format STRING &rest OBJECTS) */) | 4140 | usage: (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 | ||
| 4146 | DEFUN ("format-message", Fformat_message, Sformat_message, 1, MANY, 0, | 4146 | DEFUN ("format-message", Fformat_message, Sformat_message, 1, MANY, 0, |
| @@ -4156,13 +4156,16 @@ and right quote replacement characters are specified by | |||
| 4156 | usage: (format-message STRING &rest OBJECTS) */) | 4156 | usage: (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 | ||
| 4164 | static Lisp_Object | 4166 | Lisp_Object |
| 4165 | styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) | 4167 | styled_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 | "\ |
| 253 | Action options:\n\ | 253 | Action options:\n\ |
| 254 | \n\ | 254 | \n\ |
| 255 | FILE visit FILE using find-file\n\ | 255 | FILE 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) | |||
| 1428 | struct handler * | 1428 | struct handler * |
| 1429 | push_handler_nosignal (Lisp_Object tag_ch_val, enum handlertype handlertype) | 1429 | push_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, | |||
| 102 | Each color is a list of L*a*b* coordinates, where the L* channel ranges from | 102 | Each color is a list of L*a*b* coordinates, where the L* channel ranges from |
| 103 | 0 to 100, and the a* and b* channels range from -128 to 128. | 103 | 0 to 100, and the a* and b* channels range from -128 to 128. |
| 104 | Optional arguments KL, KC, KH are weighting parameters for lightness, | 104 | Optional arguments KL, KC, KH are weighting parameters for lightness, |
| 105 | chroma, and hue, respectively. The parameters each default to 1. */) | 105 | chroma, 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 | ||
| 142 | static double | ||
| 143 | deg2rad (double degrees) | ||
| 144 | { | ||
| 145 | return M_PI * degrees / 180.0; | ||
| 146 | } | ||
| 147 | |||
| 148 | static cmsCIEXYZ illuminant_d65 = { .X = 95.0455, .Y = 100.0, .Z = 108.8753 }; | ||
| 149 | |||
| 150 | static void | ||
| 151 | default_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 | ||
| 144 | static bool | 164 | static bool |
| @@ -160,11 +180,62 @@ parse_xyz_list (Lisp_Object xyz_list, cmsCIEXYZ *color) | |||
| 160 | return true; | 180 | return true; |
| 161 | } | 181 | } |
| 162 | 182 | ||
| 163 | DEFUN ("lcms-cam02-ucs", Flcms_cam02_ucs, Slcms_cam02_ucs, 2, 3, 0, | 183 | static bool |
| 184 | parse_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 | |||
| 225 | DEFUN ("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. |
| 165 | Each color is a list of XYZ coordinates, with Y scaled about unity. | 227 | Each color is a list of XYZ tristimulus values, with Y scaled about unity. |
| 166 | Optional argument is the XYZ white point, which defaults to illuminant D65. */) | 228 | Optional argument WHITEPOINT is the XYZ white point, which defaults to |
| 167 | (Lisp_Object color1, Lisp_Object color2, Lisp_Object whitepoint) | 229 | illuminant D65. |
| 230 | Optional argument VIEW is a list containing the viewing conditions, and | ||
| 231 | is 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 | ||
| 236 | The 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 | ||
| 240 | DEFUN ("lcms-temp->white-point", Flcms_temp_to_white_point, Slcms_temp_to_white_point, 1, 1, 0, | 307 | DEFUN ("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. |
| 242 | Valid range of TEMPERATURE is from 4000K to 25000K. */) | 309 | Valid 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, | |||
| 291 | void | 358 | void |
| 292 | syms_of_lcms2 (void) | 359 | syms_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); | |||
| 3969 | extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); | 3969 | extern Lisp_Object make_buffer_string (ptrdiff_t, ptrdiff_t, bool); |
| 3970 | extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, | 3970 | extern Lisp_Object make_buffer_string_both (ptrdiff_t, ptrdiff_t, ptrdiff_t, |
| 3971 | ptrdiff_t, bool); | 3971 | ptrdiff_t, bool); |
| 3972 | extern Lisp_Object styled_format (ptrdiff_t, Lisp_Object *, bool, bool); | ||
| 3972 | extern void init_editfns (bool); | 3973 | extern void init_editfns (bool); |
| 3973 | extern void syms_of_editfns (void); | 3974 | extern 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. | |||
| 9166 | This variable is ignored on Mac OS X < 10.7 and GNUstep. */); | 9284 | This 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. | ||
| 9290 | This 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. | ||
| 9295 | Nil or a non-number means use the default frame line height. | ||
| 9296 | This 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. | ||
| 9301 | This 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) | |||
| 155 | static void | 155 | static void |
| 156 | tty_send_additional_strings (struct terminal *terminal, Lisp_Object sym) | 156 | tty_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, "", | |||
| 19525 | usage: (trace-to-stderr STRING &rest OBJECTS) */) | 19525 | usage: (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. | ||
| 54 | Used 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'. | ||
| 63 | Since `should' failures which happen inside `post-command-hook' will | ||
| 64 | be trapped by the command loop, this preserves them until we get | ||
| 65 | back 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. | ||
| 157 | MACRO should be a list, where each item is either a keyboard | ||
| 158 | macro segment (in string or vector form) or a Lisp expression. | ||
| 159 | Convert the macro segments into keyboard macros and execute them. | ||
| 160 | After the execution of the last event of each segment, evaluate | ||
| 161 | the 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. | ||
| 170 | MACRO should be a list containing strings, vectors, and Lisp | ||
| 171 | forms. Convert the strings and vectors to keyboard macros in | ||
| 172 | vector representation and concatenate them to make a single | ||
| 173 | keyboard macro. Also build a list of the same length as the | ||
| 174 | number of events in the keyboard macro. Each item in that list | ||
| 175 | will contain the code to evaluate after the corresponding event | ||
| 176 | in the keyboard macro, either nil or a thunk built from the forms | ||
| 177 | in the original list. Return a list containing the keyboard | ||
| 178 | macro as the first item, followed by the list of thunks and/or | ||
| 179 | nils." | ||
| 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. | ||
| 203 | All 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. | ||
| 217 | KBDMAC should be a vector of events and THUNKS a list of the | ||
| 218 | same length containing thunks and/or nils. Run the macro, and | ||
| 219 | after the execution of every command in the macro (which may not | ||
| 220 | be the same as every keystroke) execute the thunk at the same | ||
| 221 | index." | ||
| 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'. | ||
| 241 | Useful to prevent `exit-recursive-edit' from stopping the current | ||
| 242 | keyboard 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'. | ||
| 266 | Find a definition for DEF-NAME in the current buffer and evaluate it. | ||
| 267 | Set globals so that `edebug-tests-call-instrumented-func' which | ||
| 268 | is bound to @ for edebug-tests' keyboard macros will call it with | ||
| 269 | ARGS. 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. | ||
| 288 | DEF-NAME should be the suffix of a definition in the code samples | ||
| 289 | file (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. | ||
| 296 | DEF-NAME should be the suffix of a definition in the code samples | ||
| 297 | file (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*. | ||
| 307 | Then 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. | ||
| 314 | Place 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. | ||
| 327 | NAME should be a string and NAMES-AND-NUMBERS an alist which can | ||
| 328 | be used by this macro to retain state. If NAME for example is | ||
| 329 | \"symbol\" then the first and subsequent uses of this macro will | ||
| 330 | evaluate 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. | ||
| 344 | Write the loadable code to a buffer for TMPFILE, and set | ||
| 345 | `edebug-tests-stop-points' to a map from defined symbols to stop | ||
| 346 | point 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. | ||
| 392 | If this test fails, one of two things is true. Either your | ||
| 393 | customizations modify `edebug-mode-map', in which case starting | ||
| 394 | Emacs with the -Q flag should fix the problem, or | ||
| 395 | `edebug-mode-map' has changed in edebug.el, in which case this | ||
| 396 | test 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 |