diff options
| author | Andrea Corallo | 2020-08-09 15:03:23 +0200 |
|---|---|---|
| committer | Andrea Corallo | 2020-08-09 15:03:23 +0200 |
| commit | 12a982d9789052d8e85efcacb4b311f4876c882a (patch) | |
| tree | a452a8e888c6ee9c85d6a487359b7a1c0c9fa15b | |
| parent | 80d7f710f2fab902e46aa3fddb8e1c1795420af3 (diff) | |
| parent | 8e82baf5a730ff542118ddba5b76afdc1db643f6 (diff) | |
| download | emacs-12a982d9789052d8e85efcacb4b311f4876c882a.tar.gz emacs-12a982d9789052d8e85efcacb4b311f4876c882a.zip | |
Merge remote-tracking branch 'savannah/master' into HEAD
190 files changed, 6040 insertions, 1731 deletions
diff --git a/.gitignore b/.gitignore index aebd507486e..0bcd73eb719 100644 --- a/.gitignore +++ b/.gitignore | |||
| @@ -153,6 +153,7 @@ test/manual/etags/regexfile | |||
| 153 | test/manual/etags/ETAGS | 153 | test/manual/etags/ETAGS |
| 154 | test/manual/etags/CTAGS | 154 | test/manual/etags/CTAGS |
| 155 | test/manual/indent/*.new | 155 | test/manual/indent/*.new |
| 156 | test/data/mml-sec/random_seed | ||
| 156 | 157 | ||
| 157 | # ctags, etags. | 158 | # ctags, etags. |
| 158 | TAGS | 159 | TAGS |
diff --git a/ChangeLog.3 b/ChangeLog.3 index 4aa52a762fc..c8dd40b5eb6 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 | |||
| @@ -58779,7 +58779,7 @@ | |||
| 58779 | 58779 | ||
| 58780 | * lisp/net/soap-client.el (soap-type-of): Optimize for Emacs≥26 | 58780 | * lisp/net/soap-client.el (soap-type-of): Optimize for Emacs≥26 |
| 58781 | 58781 | ||
| 58782 | 2018-07-17 Alex <agrambot@gmail.com> | 58782 | 2018-07-17 Alexander Gramiak <agrambot@gmail.com> |
| 58783 | 58783 | ||
| 58784 | Remove menu name from emacs-lisp-mode-map (Bug#27114) | 58784 | Remove menu name from emacs-lisp-mode-map (Bug#27114) |
| 58785 | 58785 | ||
diff --git a/admin/authors.el b/admin/authors.el index 1c069173c85..cf9cf9871e5 100644 --- a/admin/authors.el +++ b/admin/authors.el | |||
| @@ -212,7 +212,6 @@ files.") | |||
| 212 | ("Carlos Pita" "memeplex") | 212 | ("Carlos Pita" "memeplex") |
| 213 | ("Vinicius Jose Latorre" "viniciusjl") | 213 | ("Vinicius Jose Latorre" "viniciusjl") |
| 214 | ("Gaby Launay" "galaunay") | 214 | ("Gaby Launay" "galaunay") |
| 215 | ("Alex Gramiak" "alex") | ||
| 216 | ("Dick R. Chiang" "dickmao") | 215 | ("Dick R. Chiang" "dickmao") |
| 217 | ) | 216 | ) |
| 218 | "Alist of author aliases. | 217 | "Alist of author aliases. |
diff --git a/configure.ac b/configure.ac index 78fe1f9b21c..76a3e6b1960 100644 --- a/configure.ac +++ b/configure.ac | |||
| @@ -749,44 +749,21 @@ case "${canonical}" in | |||
| 749 | opsys=aix4-2 | 749 | opsys=aix4-2 |
| 750 | ;; | 750 | ;; |
| 751 | 751 | ||
| 752 | ## Suns | 752 | ## Solaris |
| 753 | *-sun-solaris* \ | 753 | *-*-solaris* | *-*-sunos*) |
| 754 | | i[3456]86-*-solaris2* | i[3456]86-*-sunos5* \ | ||
| 755 | | x86_64-*-solaris2* | x86_64-*-sunos5*) | ||
| 756 | case "${canonical}" in | 754 | case "${canonical}" in |
| 757 | i[3456]86-*-* ) ;; | 755 | i[3456]86-*-* ) ;; |
| 758 | amd64-*-*|x86_64-*-*) ;; | 756 | amd64-*-*|x86_64-*-*) ;; |
| 759 | sparc* ) ;; | 757 | sparc* ) ;; |
| 760 | * ) unported=yes ;; | 758 | * ) unported=yes ;; |
| 761 | esac | 759 | esac |
| 762 | case "${canonical}" in | 760 | opsys=solaris |
| 763 | *-sunos5.[1-9][0-9]* | *-solaris2.[1-9][0-9]* ) | ||
| 764 | opsys=sol2-10 | ||
| 765 | emacs_check_sunpro_c=yes | ||
| 766 | ;; | ||
| 767 | *-sunos5.[1-5]* | *-solaris2.[1-5]* ) unported=yes ;; | ||
| 768 | ## Note that Emacs 23.1's NEWS said the following would be dropped. | ||
| 769 | *-sunos5.6* | *-solaris2.6* ) | ||
| 770 | opsys=sol2-6 | ||
| 771 | RANLIB="ar -ts" | ||
| 772 | ;; | ||
| 773 | ## 5.7 EOL Aug 2008, 5.8 EOL Mar 2012. | ||
| 774 | *-sunos5.[7-9]* | *-solaris2.[7-9]* ) | ||
| 775 | opsys=sol2-6 | ||
| 776 | emacs_check_sunpro_c=yes | ||
| 777 | ;; | ||
| 778 | esac | ||
| 779 | ## Watch out for a compiler that we know will not work. | 761 | ## Watch out for a compiler that we know will not work. |
| 780 | case "${canonical}" in | 762 | if [ "$CC" = /usr/ucb/cc ]; then |
| 781 | *-solaris* | *-sunos5* ) | 763 | ## /usr/ucb/cc doesn't work; |
| 782 | if [ "x$CC" = x/usr/ucb/cc ]; then | 764 | ## we should find some other compiler that does work. |
| 783 | ## /usr/ucb/cc doesn't work; | 765 | unset CC |
| 784 | ## we should find some other compiler that does work. | 766 | fi |
| 785 | unset CC | ||
| 786 | fi | ||
| 787 | ;; | ||
| 788 | *) ;; | ||
| 789 | esac | ||
| 790 | ;; | 767 | ;; |
| 791 | 768 | ||
| 792 | ## QNX Neutrino | 769 | ## QNX Neutrino |
| @@ -1477,14 +1454,11 @@ case "$opsys" in | |||
| 1477 | mingw32) | 1454 | mingw32) |
| 1478 | UNEXEC_OBJ=unexw32.o | 1455 | UNEXEC_OBJ=unexw32.o |
| 1479 | ;; | 1456 | ;; |
| 1480 | sol2-10) | 1457 | solaris) |
| 1481 | # Use the Solaris dldump() function, called from unexsol.c, to dump | 1458 | # Use the Solaris dldump() function, called from unexsol.c, to dump |
| 1482 | # emacs, instead of the generic ELF dump code found in unexelf.c. | 1459 | # emacs, instead of the generic ELF dump code found in unexelf.c. |
| 1483 | # The resulting binary has a complete symbol table, and is better | 1460 | # The resulting binary has a complete symbol table, and is better |
| 1484 | # for debugging and other observability tools (debuggers, pstack, etc). | 1461 | # for debugging and other observability tools (debuggers, pstack, etc). |
| 1485 | # | ||
| 1486 | # It is likely that dldump() works with older Solaris too, but this has | ||
| 1487 | # not been tested, so for now this change is for Solaris 10 or newer. | ||
| 1488 | UNEXEC_OBJ=unexsol.o | 1462 | UNEXEC_OBJ=unexsol.o |
| 1489 | ;; | 1463 | ;; |
| 1490 | *) | 1464 | *) |
| @@ -1587,7 +1561,7 @@ case "$opsys" in | |||
| 1587 | 1561 | ||
| 1588 | qnxnto) LIBS_SYSTEM="-lsocket" ;; | 1562 | qnxnto) LIBS_SYSTEM="-lsocket" ;; |
| 1589 | 1563 | ||
| 1590 | sol2*) LIBS_SYSTEM="-lsocket -lnsl" ;; | 1564 | solaris) LIBS_SYSTEM="-lsocket -lnsl" ;; |
| 1591 | 1565 | ||
| 1592 | ## Motif needs -lgen. | 1566 | ## Motif needs -lgen. |
| 1593 | unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;; | 1567 | unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;; |
| @@ -1648,7 +1622,7 @@ case $opsys in | |||
| 1648 | SYSTEM_TYPE=berkeley-unix | 1622 | SYSTEM_TYPE=berkeley-unix |
| 1649 | ;; | 1623 | ;; |
| 1650 | 1624 | ||
| 1651 | sol2* | unixware ) | 1625 | solaris | unixware ) |
| 1652 | SYSTEM_TYPE=usg-unix-v | 1626 | SYSTEM_TYPE=usg-unix-v |
| 1653 | ;; | 1627 | ;; |
| 1654 | 1628 | ||
| @@ -2292,7 +2266,7 @@ system_malloc=yes | |||
| 2292 | test $with_unexec = yes && | 2266 | test $with_unexec = yes && |
| 2293 | case "$opsys" in | 2267 | case "$opsys" in |
| 2294 | ## darwin ld insists on the use of malloc routines in the System framework. | 2268 | ## darwin ld insists on the use of malloc routines in the System framework. |
| 2295 | darwin | mingw32 | nacl | sol2-10) ;; | 2269 | darwin | mingw32 | nacl | solaris) ;; |
| 2296 | cygwin | qnxnto | freebsd) | 2270 | cygwin | qnxnto | freebsd) |
| 2297 | hybrid_malloc=yes | 2271 | hybrid_malloc=yes |
| 2298 | system_malloc= ;; | 2272 | system_malloc= ;; |
| @@ -2428,7 +2402,7 @@ if test "$ac_cv_header_pthread_h" && test "$opsys" != "mingw32"; then | |||
| 2428 | # need special flags to disable these optimizations. For example, the | 2402 | # need special flags to disable these optimizations. For example, the |
| 2429 | # definition of 'errno' in <errno.h>. | 2403 | # definition of 'errno' in <errno.h>. |
| 2430 | case $opsys in | 2404 | case $opsys in |
| 2431 | hpux* | sol*) | 2405 | hpux* | solaris) |
| 2432 | AC_DEFINE([_REENTRANT], 1, | 2406 | AC_DEFINE([_REENTRANT], 1, |
| 2433 | [Define to 1 if your system requires this in multithreaded code.]);; | 2407 | [Define to 1 if your system requires this in multithreaded code.]);; |
| 2434 | aix4-2) | 2408 | aix4-2) |
| @@ -2558,7 +2532,7 @@ fail; | |||
| 2558 | ## inoue@ainet.or.jp says Solaris has a bug related to X11R6-style | 2532 | ## inoue@ainet.or.jp says Solaris has a bug related to X11R6-style |
| 2559 | ## XIM support. | 2533 | ## XIM support. |
| 2560 | case "$opsys" in | 2534 | case "$opsys" in |
| 2561 | sol2-*) : ;; | 2535 | solaris) : ;; |
| 2562 | *) AC_DEFINE(HAVE_X11R6_XIM, 1, | 2536 | *) AC_DEFINE(HAVE_X11R6_XIM, 1, |
| 2563 | [Define if you have usable X11R6-style XIM support.]) | 2537 | [Define if you have usable X11R6-style XIM support.]) |
| 2564 | ;; | 2538 | ;; |
| @@ -4600,11 +4574,13 @@ AC_CHECK_HEADERS(valgrind/valgrind.h) | |||
| 4600 | 4574 | ||
| 4601 | AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]]) | 4575 | AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]]) |
| 4602 | 4576 | ||
| 4603 | AC_CHECK_FUNCS_ONCE([sbrk]) | 4577 | AC_CHECK_FUNCS_ONCE([__lsan_ignore_object sbrk]) |
| 4604 | 4578 | ||
| 4605 | AC_FUNC_FORK | 4579 | AC_FUNC_FORK |
| 4606 | 4580 | ||
| 4607 | AC_CHECK_FUNCS(snprintf __lsan_ignore_object) | 4581 | dnl AC_CHECK_FUNCS_ONCE wouldn’t be right for snprintf, which needs |
| 4582 | dnl the current CFLAGS etc. | ||
| 4583 | AC_CHECK_FUNCS(snprintf) | ||
| 4608 | 4584 | ||
| 4609 | dnl Check for glib. This differs from other library checks in that | 4585 | dnl Check for glib. This differs from other library checks in that |
| 4610 | dnl Emacs need not link to glib unless some other library is already | 4586 | dnl Emacs need not link to glib unless some other library is already |
| @@ -4778,7 +4754,7 @@ if test "$USE_X_TOOLKIT" != "none"; then | |||
| 4778 | fi | 4754 | fi |
| 4779 | 4755 | ||
| 4780 | case $opsys in | 4756 | case $opsys in |
| 4781 | sol2* | unixware ) | 4757 | solaris | unixware ) |
| 4782 | dnl Some SVr4s don't define NSIG in sys/signal.h for ANSI environments; | 4758 | dnl Some SVr4s don't define NSIG in sys/signal.h for ANSI environments; |
| 4783 | dnl instead, there's a system variable _sys_nsig. Unfortunately, we | 4759 | dnl instead, there's a system variable _sys_nsig. Unfortunately, we |
| 4784 | dnl need the constant to dimension an array. So wire in the appropriate | 4760 | dnl need the constant to dimension an array. So wire in the appropriate |
| @@ -4791,7 +4767,7 @@ emacs_broken_SIGIO=no | |||
| 4791 | 4767 | ||
| 4792 | case $opsys in | 4768 | case $opsys in |
| 4793 | dnl SIGIO exists, but the feature doesn't work in the way Emacs needs. | 4769 | dnl SIGIO exists, but the feature doesn't work in the way Emacs needs. |
| 4794 | hpux* | nacl | openbsd | sol2* | unixware ) | 4770 | hpux* | nacl | openbsd | solaris | unixware ) |
| 4795 | emacs_broken_SIGIO=yes | 4771 | emacs_broken_SIGIO=yes |
| 4796 | ;; | 4772 | ;; |
| 4797 | 4773 | ||
| @@ -4840,7 +4816,7 @@ case $opsys in | |||
| 4840 | esac | 4816 | esac |
| 4841 | 4817 | ||
| 4842 | case $opsys in | 4818 | case $opsys in |
| 4843 | gnu-* | sol2-10 ) | 4819 | gnu-* | solaris ) |
| 4844 | dnl FIXME Can't we test if this exists (eg /proc/$$)? | 4820 | dnl FIXME Can't we test if this exists (eg /proc/$$)? |
| 4845 | AC_DEFINE(HAVE_PROCFS, 1, [Define if you have the /proc filesystem.]) | 4821 | AC_DEFINE(HAVE_PROCFS, 1, [Define if you have the /proc filesystem.]) |
| 4846 | ;; | 4822 | ;; |
| @@ -4969,7 +4945,7 @@ case $opsys in | |||
| 4969 | AC_DEFINE(PTY_TTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/pty/tty%c%x", c, i);]) | 4945 | AC_DEFINE(PTY_TTY_NAME_SPRINTF, [sprintf (pty_name, "/dev/pty/tty%c%x", c, i);]) |
| 4970 | ;; | 4946 | ;; |
| 4971 | 4947 | ||
| 4972 | sol2* ) | 4948 | solaris ) |
| 4973 | dnl On SysVr4, grantpt(3) forks a subprocess, so do not use | 4949 | dnl On SysVr4, grantpt(3) forks a subprocess, so do not use |
| 4974 | dnl O_CLOEXEC when opening the pty, and keep the SIGCHLD handler | 4950 | dnl O_CLOEXEC when opening the pty, and keep the SIGCHLD handler |
| 4975 | dnl from intercepting that death. If any child but grantpt's should die | 4951 | dnl from intercepting that death. If any child but grantpt's should die |
| @@ -4979,7 +4955,7 @@ case $opsys in | |||
| 4979 | ;; | 4955 | ;; |
| 4980 | 4956 | ||
| 4981 | unixware ) | 4957 | unixware ) |
| 4982 | dnl Comments are as per sol2*. | 4958 | dnl Comments are as per solaris. |
| 4983 | AC_DEFINE(PTY_OPEN, [fd = open (pty_name, O_RDWR | O_NONBLOCK)]) | 4959 | AC_DEFINE(PTY_OPEN, [fd = open (pty_name, O_RDWR | O_NONBLOCK)]) |
| 4984 | AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) | 4960 | AC_DEFINE(PTY_TTY_NAME_SPRINTF, [{ char *ptsname (int), *ptyname; int grantpt_result; sigset_t blocked; sigemptyset (&blocked); sigaddset (&blocked, SIGCHLD); pthread_sigmask (SIG_BLOCK, &blocked, 0); grantpt_result = grantpt (fd); pthread_sigmask (SIG_UNBLOCK, &blocked, 0); if (grantpt_result == -1) fatal("could not grant slave pty"); if (unlockpt(fd) == -1) fatal("could not unlock slave pty"); if (!(ptyname = ptsname(fd))) fatal ("could not enable slave pty"); snprintf (pty_name, PTY_NAME_SIZE, "%s", ptyname); }]) |
| 4985 | ;; | 4961 | ;; |
| @@ -4987,7 +4963,7 @@ esac | |||
| 4987 | 4963 | ||
| 4988 | 4964 | ||
| 4989 | case $opsys in | 4965 | case $opsys in |
| 4990 | sol2* | unixware ) | 4966 | solaris | unixware ) |
| 4991 | dnl This change means that we don't loop through allocate_pty too | 4967 | dnl This change means that we don't loop through allocate_pty too |
| 4992 | dnl many times in the (rare) event of a failure. | 4968 | dnl many times in the (rare) event of a failure. |
| 4993 | AC_DEFINE(FIRST_PTY_LETTER, ['z']) | 4969 | AC_DEFINE(FIRST_PTY_LETTER, ['z']) |
| @@ -5082,7 +5058,7 @@ if test x$GCC = xyes; then | |||
| 5082 | AC_DEFINE(GC_SETJMP_WORKS, 1) | 5058 | AC_DEFINE(GC_SETJMP_WORKS, 1) |
| 5083 | else | 5059 | else |
| 5084 | case $opsys in | 5060 | case $opsys in |
| 5085 | aix* | dragonfly | freebsd | netbsd | openbsd | sol2* ) | 5061 | aix* | dragonfly | freebsd | netbsd | openbsd | solaris ) |
| 5086 | AC_DEFINE(GC_SETJMP_WORKS, 1) | 5062 | AC_DEFINE(GC_SETJMP_WORKS, 1) |
| 5087 | ;; | 5063 | ;; |
| 5088 | esac | 5064 | esac |
| @@ -5129,7 +5105,7 @@ case $emacs_cv_func_sigsetjmp,$emacs_cv_alternate_stack,$opsys in | |||
| 5129 | esac | 5105 | esac |
| 5130 | 5106 | ||
| 5131 | case $opsys in | 5107 | case $opsys in |
| 5132 | sol2* | unixware ) | 5108 | solaris | unixware ) |
| 5133 | dnl TIOCGPGRP is broken in SysVr4, so we can't send signals to PTY | 5109 | dnl TIOCGPGRP is broken in SysVr4, so we can't send signals to PTY |
| 5134 | dnl subprocesses the usual way. But TIOCSIGNAL does work for PTYs, | 5110 | dnl subprocesses the usual way. But TIOCSIGNAL does work for PTYs, |
| 5135 | dnl and this is all we need. | 5111 | dnl and this is all we need. |
| @@ -5139,7 +5115,7 @@ esac | |||
| 5139 | 5115 | ||
| 5140 | 5116 | ||
| 5141 | case $opsys in | 5117 | case $opsys in |
| 5142 | hpux* | sol2* ) | 5118 | hpux* | solaris ) |
| 5143 | dnl Used in xfaces.c. | 5119 | dnl Used in xfaces.c. |
| 5144 | AC_DEFINE(XOS_NEEDS_TIME_H, 1, [Compensate for a bug in Xos.h on | 5120 | AC_DEFINE(XOS_NEEDS_TIME_H, 1, [Compensate for a bug in Xos.h on |
| 5145 | some systems, where it requires time.h.]) | 5121 | some systems, where it requires time.h.]) |
| @@ -5194,7 +5170,7 @@ case $opsys in | |||
| 5194 | fi | 5170 | fi |
| 5195 | ;; | 5171 | ;; |
| 5196 | 5172 | ||
| 5197 | sol2*) | 5173 | solaris) |
| 5198 | AC_DEFINE(USG, []) | 5174 | AC_DEFINE(USG, []) |
| 5199 | AC_DEFINE(USG5_4, []) | 5175 | AC_DEFINE(USG5_4, []) |
| 5200 | AC_DEFINE(SOLARIS2, [], [Define if the system is Solaris.]) | 5176 | AC_DEFINE(SOLARIS2, [], [Define if the system is Solaris.]) |
| @@ -5259,7 +5235,7 @@ case $opsys in | |||
| 5259 | reopen it in the child.]) | 5235 | reopen it in the child.]) |
| 5260 | ;; | 5236 | ;; |
| 5261 | 5237 | ||
| 5262 | sol2-10) | 5238 | solaris) |
| 5263 | AC_DEFINE(_STRUCTURED_PROC, 1, [Needed for system_process_attributes | 5239 | AC_DEFINE(_STRUCTURED_PROC, 1, [Needed for system_process_attributes |
| 5264 | on Solaris.]) | 5240 | on Solaris.]) |
| 5265 | ;; | 5241 | ;; |
diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi index fe51ad35d77..31db815df70 100644 --- a/doc/emacs/calendar.texi +++ b/doc/emacs/calendar.texi | |||
| @@ -625,6 +625,11 @@ your time zone. Emacs displays the times of sunrise and sunset | |||
| 625 | @emph{corrected for daylight saving time}. @xref{Daylight Saving}, | 625 | @emph{corrected for daylight saving time}. @xref{Daylight Saving}, |
| 626 | for how daylight saving time is determined. | 626 | for how daylight saving time is determined. |
| 627 | 627 | ||
| 628 | @vindex calendar-use-numeric-time-zones | ||
| 629 | If you want to display numerical time zones (like @samp{"+0100"}) | ||
| 630 | instead of symbolic time zones (like @samp{"CET"}), set the | ||
| 631 | @code{calendar-use-numeric-time-zones} variable to non-@code{nil}. | ||
| 632 | |||
| 628 | As a user, you might find it convenient to set the calendar location | 633 | As a user, you might find it convenient to set the calendar location |
| 629 | variables for your usual physical location in your @file{.emacs} file. | 634 | variables for your usual physical location in your @file{.emacs} file. |
| 630 | If you are a system administrator, you may want to set these variables | 635 | If you are a system administrator, you may want to set these variables |
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index e96e43b377d..75ef520d62a 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi | |||
| @@ -1334,6 +1334,10 @@ customize the variable @code{whitespace-line-column}. | |||
| 1334 | @item newline | 1334 | @item newline |
| 1335 | Highlight newlines. | 1335 | Highlight newlines. |
| 1336 | 1336 | ||
| 1337 | @item missing-newline-at-eof | ||
| 1338 | Highlight the final character if the buffer doesn't end with a newline | ||
| 1339 | character. | ||
| 1340 | |||
| 1337 | @item empty | 1341 | @item empty |
| 1338 | Highlight empty lines at the beginning and/or end of the buffer. | 1342 | Highlight empty lines at the beginning and/or end of the buffer. |
| 1339 | 1343 | ||
diff --git a/doc/emacs/files.texi b/doc/emacs/files.texi index 5998326ffef..2fa1ecc003d 100644 --- a/doc/emacs/files.texi +++ b/doc/emacs/files.texi | |||
| @@ -2149,7 +2149,12 @@ To reset all transformations to the initial state, use | |||
| 2149 | @findex image-previous-file | 2149 | @findex image-previous-file |
| 2150 | You can press @kbd{n} (@code{image-next-file}) and @kbd{p} | 2150 | You can press @kbd{n} (@code{image-next-file}) and @kbd{p} |
| 2151 | (@code{image-previous-file}) to visit the next image file and the | 2151 | (@code{image-previous-file}) to visit the next image file and the |
| 2152 | previous image file in the same directory, respectively. | 2152 | previous image file in the same directory, respectively. These |
| 2153 | commands will consult the ``parent'' dired buffer to determine what | ||
| 2154 | the next/previous image file is. These commands also work when | ||
| 2155 | opening a file from archive files (like zip or tar files), and will | ||
| 2156 | then instead consult the archive mode buffer. If neither an archive | ||
| 2157 | nor a dired ``parent'' buffer can be found, a dired buffer is opened. | ||
| 2153 | 2158 | ||
| 2154 | @findex image-mode-mark-file | 2159 | @findex image-mode-mark-file |
| 2155 | @findex image-mode-unmark-file | 2160 | @findex image-mode-unmark-file |
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 167c32c4d21..06ad5a583d2 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi | |||
| @@ -220,6 +220,16 @@ documentation string of the command it runs. | |||
| 220 | command is not on any key, that means you must use @kbd{M-x} to run | 220 | command is not on any key, that means you must use @kbd{M-x} to run |
| 221 | it. @kbd{C-h w} runs the command @code{where-is}. | 221 | it. @kbd{C-h w} runs the command @code{where-is}. |
| 222 | 222 | ||
| 223 | @findex button-describe | ||
| 224 | @findex widget-describe | ||
| 225 | Some modes in Emacs use various buttons (@pxref{Buttons,,,elisp, The | ||
| 226 | Emacs Lisp Reference Manual}) and widgets | ||
| 227 | (@pxref{Introduction,,,widget, Emacs Widgets}) that can be clicked to | ||
| 228 | perform some action. To find out what function is ultimately invoked | ||
| 229 | by these buttons, Emacs provides the @code{button-describe} and | ||
| 230 | @code{widget-describe} commands, that should be run with point over | ||
| 231 | the button. | ||
| 232 | |||
| 223 | @node Name Help | 233 | @node Name Help |
| 224 | @section Help by Command or Variable Name | 234 | @section Help by Command or Variable Name |
| 225 | 235 | ||
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index 6b1f35e6158..bd7dbb6f515 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi | |||
| @@ -577,7 +577,9 @@ regions to the primary selection entirely. | |||
| 577 | 577 | ||
| 578 | To insert the primary selection into an Emacs buffer, click | 578 | To insert the primary selection into an Emacs buffer, click |
| 579 | @kbd{mouse-2} (@code{mouse-yank-primary}) where you want to insert it. | 579 | @kbd{mouse-2} (@code{mouse-yank-primary}) where you want to insert it. |
| 580 | @xref{Mouse Commands}. | 580 | @xref{Mouse Commands}. You can also use the normal Emacs yank command |
| 581 | (@kbd{C-y}) to insert this text if @code{select-enable-primary} is set | ||
| 582 | (@pxref{Clipboard}). | ||
| 581 | 583 | ||
| 582 | @cindex MS-Windows, and primary selection | 584 | @cindex MS-Windows, and primary selection |
| 583 | MS-Windows provides no primary selection, but Emacs emulates it | 585 | MS-Windows provides no primary selection, but Emacs emulates it |
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index e7547ebff7c..cb9fc61f327 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi | |||
| @@ -724,13 +724,15 @@ See the Eshell Info manual, which is distributed with Emacs. | |||
| 724 | 724 | ||
| 725 | @kindex M-! | 725 | @kindex M-! |
| 726 | @findex shell-command | 726 | @findex shell-command |
| 727 | @vindex shell-command-buffer-name | ||
| 727 | @kbd{M-!} (@code{shell-command}) reads a line of text using the | 728 | @kbd{M-!} (@code{shell-command}) reads a line of text using the |
| 728 | minibuffer and executes it as a shell command, in a subshell made just | 729 | minibuffer and executes it as a shell command, in a subshell made just |
| 729 | for that command. Standard input for the command comes from the null | 730 | for that command. Standard input for the command comes from the null |
| 730 | device. If the shell command produces any output, the output appears | 731 | device. If the shell command produces any output, the output appears |
| 731 | either in the echo area (if it is short), or in an Emacs buffer named | 732 | either in the echo area (if it is short), or in an Emacs buffer, |
| 732 | @file{*Shell Command Output*}, displayed in another window (if the | 733 | displayed in another window (if the output is long). The name of |
| 733 | output is long). The variables @code{resize-mini-windows} and | 734 | this buffer is taken from the constant @code{shell-command-buffer-name}. |
| 735 | The variables @code{resize-mini-windows} and | ||
| 734 | @code{max-mini-window-height} (@pxref{Minibuffer Edit}) control when | 736 | @code{max-mini-window-height} (@pxref{Minibuffer Edit}) control when |
| 735 | Emacs should consider the output to be too long for the echo area. | 737 | Emacs should consider the output to be too long for the echo area. |
| 736 | 738 | ||
| @@ -758,15 +760,16 @@ which is impossible to ignore. | |||
| 758 | 760 | ||
| 759 | @kindex M-& | 761 | @kindex M-& |
| 760 | @findex async-shell-command | 762 | @findex async-shell-command |
| 763 | @vindex shell-command-buffer-name-async | ||
| 761 | A shell command that ends in @samp{&} is executed | 764 | A shell command that ends in @samp{&} is executed |
| 762 | @dfn{asynchronously}, and you can continue to use Emacs as it runs. | 765 | @dfn{asynchronously}, and you can continue to use Emacs as it runs. |
| 763 | You can also type @kbd{M-&} (@code{async-shell-command}) to execute a | 766 | You can also type @kbd{M-&} (@code{async-shell-command}) to execute a |
| 764 | shell command asynchronously; this is exactly like calling @kbd{M-!} | 767 | shell command asynchronously; this is exactly like calling @kbd{M-!} |
| 765 | with a trailing @samp{&}, except that you do not need the @samp{&}. | 768 | with a trailing @samp{&}, except that you do not need the @samp{&}. |
| 766 | The default output buffer for asynchronous shell commands is named | 769 | The constant @code{shell-command-buffer-name-async} stores the name |
| 767 | @samp{*Async Shell Command*}. Emacs inserts the output into this | 770 | of the default output buffer for asynchronous shell commands. |
| 768 | buffer as it comes in, whether or not the buffer is visible in a | 771 | Emacs inserts the output into this buffer as it comes in, |
| 769 | window. | 772 | whether or not the buffer is visible in a window. |
| 770 | 773 | ||
| 771 | @vindex async-shell-command-buffer | 774 | @vindex async-shell-command-buffer |
| 772 | If you want to run more than one asynchronous shell command at the | 775 | If you want to run more than one asynchronous shell command at the |
| @@ -804,7 +807,7 @@ old region and replaces it with the output from the shell command. | |||
| 804 | see what keys are in the buffer. If the buffer contains a GnuPG key, | 807 | see what keys are in the buffer. If the buffer contains a GnuPG key, |
| 805 | type @kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents | 808 | type @kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents |
| 806 | to @command{gpg}. This will output the list of keys to the | 809 | to @command{gpg}. This will output the list of keys to the |
| 807 | @file{*Shell Command Output*} buffer. | 810 | buffer named @code{shell-command-buffer-name}. |
| 808 | 811 | ||
| 809 | @vindex shell-file-name | 812 | @vindex shell-file-name |
| 810 | The above commands use the shell specified by the variable | 813 | The above commands use the shell specified by the variable |
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 25eabd6c3fc..d3adb62c1bd 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi | |||
| @@ -5572,6 +5572,15 @@ The value, @var{width}, specifies the width of the image, in pixels. | |||
| 5572 | @item :height @var{height} | 5572 | @item :height @var{height} |
| 5573 | The value, @var{height}, specifies the height of the image, in pixels. | 5573 | The value, @var{height}, specifies the height of the image, in pixels. |
| 5574 | 5574 | ||
| 5575 | Note that @code{:width} and @code{:height} can only be used if passing | ||
| 5576 | in data that doesn't specify the width and height (e.g., a string or a | ||
| 5577 | vector containing the bits of the image). @acronym{XBM} files usually | ||
| 5578 | specify this themselves, and it's an error to use these two properties | ||
| 5579 | on these files. Also note that @code{:width} and @code{:height} are | ||
| 5580 | used by most other image formats to specify what the displayed image | ||
| 5581 | is supposed to be, which usually means performing some sort of | ||
| 5582 | scaling. This isn't supported for @acronym{XBM} images. | ||
| 5583 | |||
| 5575 | @item :stride @var{stride} | 5584 | @item :stride @var{stride} |
| 5576 | The number of bool vector entries stored for each row; the smallest | 5585 | The number of bool vector entries stored for each row; the smallest |
| 5577 | multiple of 8 greater than or equal to @var{width}. | 5586 | multiple of 8 greater than or equal to @var{width}. |
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index d879f3dcadf..6404e068dae 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi | |||
| @@ -1438,6 +1438,16 @@ name component for the definition. You can use this to add a unique, | |||
| 1438 | static component to the name of the definition. It may be used more | 1438 | static component to the name of the definition. It may be used more |
| 1439 | than once. | 1439 | than once. |
| 1440 | 1440 | ||
| 1441 | @item :unique | ||
| 1442 | This construct is like @code{:name}, but generates unique names. It | ||
| 1443 | does not match an argument. The element following @code{:unique} | ||
| 1444 | should be a string; it is used as the prefix for an additional name | ||
| 1445 | component for the definition. You can use this to add a unique, | ||
| 1446 | dynamic component to the name of the definition. This is useful for | ||
| 1447 | macros that can define the same symbol multiple times in different | ||
| 1448 | scopes, such as @code{cl-flet}; @ref{Function Bindings,,,cl}. It may | ||
| 1449 | be used more than once. | ||
| 1450 | |||
| 1441 | @item arg | 1451 | @item arg |
| 1442 | The argument, a symbol, is the name of an argument of the defining form. | 1452 | The argument, a symbol, is the name of an argument of the defining form. |
| 1443 | However, lambda-list keywords (symbols starting with @samp{&}) | 1453 | However, lambda-list keywords (symbols starting with @samp{&}) |
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 942bda105f7..504f0dfb23e 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi | |||
| @@ -2687,9 +2687,9 @@ Emacs is restarted by the session manager. | |||
| 2687 | 2687 | ||
| 2688 | @group | 2688 | @group |
| 2689 | (defun save-yourself-test () | 2689 | (defun save-yourself-test () |
| 2690 | (insert "(save-current-buffer | 2690 | (insert |
| 2691 | (switch-to-buffer \"*scratch*\") | 2691 | (format "%S" '(with-current-buffer "*scratch*" |
| 2692 | (insert \"I am restored\"))") | 2692 | (insert "I am restored")))) |
| 2693 | nil) | 2693 | nil) |
| 2694 | @end group | 2694 | @end group |
| 2695 | @end example | 2695 | @end example |
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 2f38dcd4956..9180b4ec205 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi | |||
| @@ -472,6 +472,13 @@ the case if you save it to disk and launch it in a different way | |||
| 472 | to launch any external programs, set this variable to @code{nil} or | 472 | to launch any external programs, set this variable to @code{nil} or |
| 473 | @code{ask}. | 473 | @code{ask}. |
| 474 | 474 | ||
| 475 | @item mm-inline-font-lock | ||
| 476 | @vindex mm-inline-font-lock | ||
| 477 | If non-@code{nil}, inlined parts that support font locking (for | ||
| 478 | instance, patches or code snippets) will be font-locked. This may be | ||
| 479 | overriden by callers that have their own ways of enabling/inhibiting | ||
| 480 | font locking. | ||
| 481 | |||
| 475 | @end table | 482 | @end table |
| 476 | 483 | ||
| 477 | @node Files and Directories | 484 | @node Files and Directories |
| @@ -686,8 +693,17 @@ Valid values are @samp{inline} and @samp{attachment} | |||
| 686 | 693 | ||
| 687 | @item encoding | 694 | @item encoding |
| 688 | Valid values are @samp{7bit}, @samp{8bit}, @samp{quoted-printable} and | 695 | Valid values are @samp{7bit}, @samp{8bit}, @samp{quoted-printable} and |
| 689 | @samp{base64} (@code{Content-Transfer-Encoding}). @xref{Charset | 696 | @samp{base64}. @xref{Charset |
| 690 | Translation}. | 697 | Translation}. This parameter says what |
| 698 | @code{Content-Transfer-Encoding} to use when sending the part, and is | ||
| 699 | normally computed automatically. | ||
| 700 | |||
| 701 | @item data-encoding | ||
| 702 | This parameter says what encoding has been used on the data, and the | ||
| 703 | data will be decoded before use. Valid values are | ||
| 704 | @samp{quoted-printable} and @samp{base64}. This is useful when you | ||
| 705 | have a part with binary data (for instance an image) inserted directly | ||
| 706 | into the Message buffer inside the @samp{"<#part>...<#/part>"} tags. | ||
| 691 | 707 | ||
| 692 | @item description | 708 | @item description |
| 693 | A description of the part (@code{Content-Description}). | 709 | A description of the part (@code{Content-Description}). |
diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index f9901b6fd78..85be112402c 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi | |||
| @@ -52,6 +52,7 @@ modify this GNU manual.'' | |||
| 52 | * Overview:: | 52 | * Overview:: |
| 53 | * Basics:: | 53 | * Basics:: |
| 54 | * Advanced:: | 54 | * Advanced:: |
| 55 | * Command Line:: | ||
| 55 | 56 | ||
| 56 | Appendices | 57 | Appendices |
| 57 | * History and Acknowledgments:: | 58 | * History and Acknowledgments:: |
| @@ -337,6 +338,21 @@ thus allowing for the use of the usual substitutions, such as | |||
| 337 | @code{\[eww-reload]} for the current key binding of the | 338 | @code{\[eww-reload]} for the current key binding of the |
| 338 | @code{eww-reload} command. | 339 | @code{eww-reload} command. |
| 339 | 340 | ||
| 341 | @node Command Line | ||
| 342 | @chapter Command Line Usage | ||
| 343 | |||
| 344 | It can be convenient to start eww directly from the command line. The | ||
| 345 | @code{eww-browse} function can be used for that: | ||
| 346 | |||
| 347 | @example | ||
| 348 | emacs -f eww-browse https://gnu.org | ||
| 349 | @end example | ||
| 350 | |||
| 351 | This also allows registering Emacs as a @acronym{MIME} handler for the | ||
| 352 | @samp{"text/x-uri"} media type. How to do that varies between | ||
| 353 | systems, but typically you'd register the handler to call @samp{"emacs | ||
| 354 | -f eww-browse %u"}. | ||
| 355 | |||
| 340 | @node History and Acknowledgments | 356 | @node History and Acknowledgments |
| 341 | @appendix History and Acknowledgments | 357 | @appendix History and Acknowledgments |
| 342 | 358 | ||
diff --git a/doc/misc/message.texi b/doc/misc/message.texi index bdd31b1fe49..204a6386e01 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi | |||
| @@ -99,6 +99,7 @@ sending it. | |||
| 99 | * Resending:: Resending a mail message. | 99 | * Resending:: Resending a mail message. |
| 100 | * Bouncing:: Bouncing a mail message. | 100 | * Bouncing:: Bouncing a mail message. |
| 101 | * Mailing Lists:: Send mail to mailing lists. | 101 | * Mailing Lists:: Send mail to mailing lists. |
| 102 | * System Mailer Setup:: Using Message as the system mailer. | ||
| 102 | @end menu | 103 | @end menu |
| 103 | 104 | ||
| 104 | You can customize the Message Mode tool bar, see @kbd{M-x | 105 | You can customize the Message Mode tool bar, see @kbd{M-x |
| @@ -529,6 +530,29 @@ It is considered good netiquette to honor MFT, as it is assumed the | |||
| 529 | fellow who posted a message knows where the followups need to go | 530 | fellow who posted a message knows where the followups need to go |
| 530 | better than you do. | 531 | better than you do. |
| 531 | 532 | ||
| 533 | |||
| 534 | @node System Mailer Setup | ||
| 535 | @section System Mailer Setup | ||
| 536 | @cindex mailto: | ||
| 537 | |||
| 538 | Emacs can be set up as the system mailer, so that Emacs is opened when | ||
| 539 | you click on @samp{mailto:} links in other programs. | ||
| 540 | |||
| 541 | How this is done varies from system to system, but commonly there's a | ||
| 542 | way to set the default application for a @acronym{MIME} type, and the | ||
| 543 | relevant type here is @samp{x-scheme-handler/mailto;}. | ||
| 544 | |||
| 545 | The application to start should be @samp{"emacs -f message-mailto %u"}. | ||
| 546 | This will start Emacs, and then run the @code{message-mailto} | ||
| 547 | command. It will parse the given @acronym{URL}, and set up a Message | ||
| 548 | buffer with the given parameters. | ||
| 549 | |||
| 550 | For instance, @samp{mailto:larsi@@gnus.org?subject=This+is+a+test} | ||
| 551 | will open a Message buffer with the @samp{To:} header filled in with | ||
| 552 | @samp{"larsi@@gnus.org"} and the @samp{Subject:} header with | ||
| 553 | @samp{"This is a test"}. | ||
| 554 | |||
| 555 | |||
| 532 | @node Commands | 556 | @node Commands |
| 533 | @chapter Commands | 557 | @chapter Commands |
| 534 | 558 | ||
| @@ -883,6 +907,18 @@ is a list, valid members are @code{type}, @code{description} and | |||
| 883 | @code{nil}, don't ask for options. If it is @code{t}, ask the user | 907 | @code{nil}, don't ask for options. If it is @code{t}, ask the user |
| 884 | whether or not to specify options. | 908 | whether or not to specify options. |
| 885 | 909 | ||
| 910 | @vindex message-screenshot-command | ||
| 911 | @findex message-insert-screenshot | ||
| 912 | @cindex screenshots | ||
| 913 | @kindex C-c C-p | ||
| 914 | If your system supports it, you can also insert screenshots directly | ||
| 915 | into the Message buffer. The @kbd{C-c C-p} | ||
| 916 | (@code{message-insert-screenshot}) command inserts the image into the | ||
| 917 | buffer as an @acronym{MML} part, and puts an image text property on | ||
| 918 | top. The @code{message-screenshot-command} variable says what | ||
| 919 | external command to use to take the screenshot. It defaults to | ||
| 920 | @code{"import png:-"}, which is an ImageMagick command. | ||
| 921 | |||
| 886 | You can also create arbitrarily complex multiparts using the @acronym{MML} | 922 | You can also create arbitrarily complex multiparts using the @acronym{MML} |
| 887 | language (@pxref{Composing, , Composing, emacs-mime, The Emacs MIME | 923 | language (@pxref{Composing, , Composing, emacs-mime, The Emacs MIME |
| 888 | Manual}). | 924 | Manual}). |
| @@ -1006,6 +1042,7 @@ and/or encrypted messages as explained in the following. | |||
| 1006 | * Signing and encryption:: Signing and encrypting commands. | 1042 | * Signing and encryption:: Signing and encrypting commands. |
| 1007 | * Using S/MIME:: Using S/MIME | 1043 | * Using S/MIME:: Using S/MIME |
| 1008 | * Using OpenPGP:: Using OpenPGP | 1044 | * Using OpenPGP:: Using OpenPGP |
| 1045 | * OpenPGP Header:: Adding OpenPGP headers to messages. | ||
| 1009 | * Passphrase caching:: How to cache passphrases | 1046 | * Passphrase caching:: How to cache passphrases |
| 1010 | * PGP Compatibility:: Compatibility with older implementations | 1047 | * PGP Compatibility:: Compatibility with older implementations |
| 1011 | * Encrypt-to-self:: Reading your own encrypted messages | 1048 | * Encrypt-to-self:: Reading your own encrypted messages |
| @@ -1215,6 +1252,29 @@ according to two different standards, namely @acronym{PGP} or | |||
| 1215 | @code{mml-default-sign-method} determine which variant to prefer, | 1252 | @code{mml-default-sign-method} determine which variant to prefer, |
| 1216 | @acronym{PGP/MIME} by default. | 1253 | @acronym{PGP/MIME} by default. |
| 1217 | 1254 | ||
| 1255 | @node OpenPGP Header | ||
| 1256 | @subsection OpenPGP Header | ||
| 1257 | |||
| 1258 | The @samp{OpenPGP} header can be used to provide information about the | ||
| 1259 | sender's OpenPGP key. This is a formalization and modernization of | ||
| 1260 | the non-standard @samp{X-PGP-Key} (etc.) headers that have been in use | ||
| 1261 | for a long time. For more details, see | ||
| 1262 | @uref{https://tools.ietf.org/html/draft-josefsson-openpgp-mailnews-header}. | ||
| 1263 | |||
| 1264 | @vindex message-openpgp-header | ||
| 1265 | To use this in Message, say: | ||
| 1266 | |||
| 1267 | @lisp | ||
| 1268 | (add-hook 'message-send-hook 'message-add-openpgp-header) | ||
| 1269 | @end lisp | ||
| 1270 | |||
| 1271 | @noindent | ||
| 1272 | then customize the @code{message-openpgp-header} variable according to | ||
| 1273 | your PGP setup. The variable is a list of the key ID, the key URL or | ||
| 1274 | ASCII armored key, and the protection preference, one of | ||
| 1275 | @samp{"unprotected"}, @samp{"sign"}, @samp{"encrypt"} or | ||
| 1276 | @samp{"signencrypt"}. | ||
| 1277 | |||
| 1218 | @node Passphrase caching | 1278 | @node Passphrase caching |
| 1219 | @subsection Passphrase caching | 1279 | @subsection Passphrase caching |
| 1220 | 1280 | ||
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index b4195111d4a..ae6fe3d9ea0 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi | |||
| @@ -2053,6 +2053,13 @@ The temporary directory on the remote host. If not specified, the | |||
| 2053 | default value is @t{"/data/local/tmp"} for the @option{adb} method, | 2053 | default value is @t{"/data/local/tmp"} for the @option{adb} method, |
| 2054 | @t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise. | 2054 | @t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise. |
| 2055 | 2055 | ||
| 2056 | @item @t{"direct-async-process"} | ||
| 2057 | |||
| 2058 | When this property is non-@code{nil}, an alternative, more performant | ||
| 2059 | implementation of @code{make-process} and | ||
| 2060 | @code{start-file-process} is applied. @ref{Improving performance of | ||
| 2061 | asynchronous remote processes} for a discussion of constraints. | ||
| 2062 | |||
| 2056 | @item @t{"posix"} | 2063 | @item @t{"posix"} |
| 2057 | 2064 | ||
| 2058 | Connections using the @option{smb} method check, whether the remote | 2065 | Connections using the @option{smb} method check, whether the remote |
| @@ -2098,7 +2105,7 @@ To improve performance and accuracy of remote file access, | |||
| 2098 | @file{/usr/bin}, which are reasonable for most hosts. To accommodate | 2105 | @file{/usr/bin}, which are reasonable for most hosts. To accommodate |
| 2099 | differences in hosts and paths, for example, @file{/bin:/usr/bin} on | 2106 | differences in hosts and paths, for example, @file{/bin:/usr/bin} on |
| 2100 | Debian GNU/Linux or | 2107 | Debian GNU/Linux or |
| 2101 | @file{/usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/SUNWspro/bin} on | 2108 | @file{/usr/xpg4/bin:/usr/ccs/bin:/usr/bin:/opt/developerstudio12.6/bin} on |
| 2102 | Solaris, @value{tramp} queries the remote host with @command{getconf | 2109 | Solaris, @value{tramp} queries the remote host with @command{getconf |
| 2103 | PATH} and updates the symbol @code{tramp-default-remote-path}. | 2110 | PATH} and updates the symbol @code{tramp-default-remote-path}. |
| 2104 | 2111 | ||
| @@ -2458,10 +2465,9 @@ overwrite as follows: | |||
| 2458 | 2465 | ||
| 2459 | @lisp | 2466 | @lisp |
| 2460 | @group | 2467 | @group |
| 2461 | (add-to-list | 2468 | (add-to-list 'tramp-connection-properties |
| 2462 | 'tramp-connection-properties | 2469 | `(,(regexp-quote "192.168.0.1") |
| 2463 | `(,(regexp-quote "192.168.0.1") | 2470 | "remote-copy-args" (("-l") ("%r")))) |
| 2464 | "remote-copy-args" (("-l") ("%r")))) | ||
| 2465 | @end group | 2471 | @end group |
| 2466 | @end lisp | 2472 | @end lisp |
| 2467 | 2473 | ||
| @@ -3373,7 +3379,7 @@ host. Example: | |||
| 3373 | @end example | 3379 | @end example |
| 3374 | 3380 | ||
| 3375 | @command{tail} command outputs continuously to the local buffer, | 3381 | @command{tail} command outputs continuously to the local buffer, |
| 3376 | @file{*Async Shell Command*} | 3382 | named @code{shell-command-buffer-name-async} |
| 3377 | 3383 | ||
| 3378 | @kbd{M-x auto-revert-tail-mode @key{RET}} runs similarly showing | 3384 | @kbd{M-x auto-revert-tail-mode @key{RET}} runs similarly showing |
| 3379 | continuous output. | 3385 | continuous output. |
| @@ -3527,6 +3533,70 @@ To open @command{powershell} as a remote shell, use this: | |||
| 3527 | @end lisp | 3533 | @end lisp |
| 3528 | 3534 | ||
| 3529 | 3535 | ||
| 3536 | @anchor{Improving performance of asynchronous remote processes} | ||
| 3537 | @subsection Improving performance of asynchronous remote processes | ||
| 3538 | @cindex Asynchronous remote processes | ||
| 3539 | @findex make-process | ||
| 3540 | @findex start-file-process | ||
| 3541 | |||
| 3542 | @value{tramp}'s implementation of @code{make-process} and | ||
| 3543 | @code{start-file-process} requires a serious overhead for | ||
| 3544 | initialization, every process invocation. This is needed for handling | ||
| 3545 | interactive dialogues when connecting the remote host (like providing | ||
| 3546 | a password), and initial environment setup. | ||
| 3547 | |||
| 3548 | Sometimes, this is not needed. Instead of starting a remote shell and | ||
| 3549 | running the command afterwards, it is sufficient to run the command | ||
| 3550 | directly. @value{tramp} supports this by an alternative | ||
| 3551 | implementation of @code{make-process} and @code{start-file-process}. | ||
| 3552 | This is triggered by the connection property | ||
| 3553 | @t{"direct-async-process"}, @xref{Predefined connection information}, | ||
| 3554 | which must be set to a non-@code{nil} value. Example: | ||
| 3555 | |||
| 3556 | @lisp | ||
| 3557 | @group | ||
| 3558 | (add-to-list 'tramp-connection-properties | ||
| 3559 | (list (regexp-quote "@trampfn{ssh,user@@host,}") | ||
| 3560 | "direct-async-process" t)) | ||
| 3561 | @end group | ||
| 3562 | @end lisp | ||
| 3563 | |||
| 3564 | However, this approach has different limitations: | ||
| 3565 | |||
| 3566 | @itemize | ||
| 3567 | @item | ||
| 3568 | It works only for connection methods defined in @file{tramp-sh.el} and | ||
| 3569 | @file{tramp-adb.el}. | ||
| 3570 | |||
| 3571 | @item | ||
| 3572 | It does not support multi-hop methods. | ||
| 3573 | |||
| 3574 | @item | ||
| 3575 | It does not support interactive user authentication, like password | ||
| 3576 | handling. | ||
| 3577 | |||
| 3578 | @item | ||
| 3579 | It does not support a separated error stream. | ||
| 3580 | |||
| 3581 | @item | ||
| 3582 | It cannot be killed via @code{interrupt-process}. | ||
| 3583 | |||
| 3584 | @item | ||
| 3585 | It does not report the remote terminal name via @code{process-tty-name}. | ||
| 3586 | |||
| 3587 | @item | ||
| 3588 | It does not use @code{tramp-remote-path} and | ||
| 3589 | @code{tramp-remote-process-environment}. | ||
| 3590 | |||
| 3591 | @item | ||
| 3592 | It does not set environment variable @env{INSIDE_EMACS}. | ||
| 3593 | @end itemize | ||
| 3594 | |||
| 3595 | In order to gain even more performance, it is recommended to bind | ||
| 3596 | @code{tramp-verbose} to 0 when running @code{make-process} or | ||
| 3597 | @code{start-file-process}. | ||
| 3598 | |||
| 3599 | |||
| 3530 | @node Cleanup remote connections | 3600 | @node Cleanup remote connections |
| 3531 | @section Cleanup remote connections | 3601 | @section Cleanup remote connections |
| 3532 | @cindex cleanup | 3602 | @cindex cleanup |
| @@ -4555,9 +4625,8 @@ Abbreviation list expansion can be used to reduce typing long file names: | |||
| 4555 | 4625 | ||
| 4556 | @lisp | 4626 | @lisp |
| 4557 | @group | 4627 | @group |
| 4558 | (add-to-list | 4628 | (add-to-list 'directory-abbrev-alist |
| 4559 | 'directory-abbrev-alist | 4629 | '("^/xy" . "@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}")) |
| 4560 | '("^/xy" . "@trampfn{ssh,news@@news.my.domain,/opt/news/etc/}")) | ||
| 4561 | @end group | 4630 | @end group |
| 4562 | @end lisp | 4631 | @end lisp |
| 4563 | 4632 | ||
diff --git a/etc/MACHINES b/etc/MACHINES index 1bb244b49b0..78e9cef0fd7 100644 --- a/etc/MACHINES +++ b/etc/MACHINES | |||
| @@ -81,25 +81,26 @@ the list at the end of this file. | |||
| 81 | 81 | ||
| 82 | ** Solaris | 82 | ** Solaris |
| 83 | 83 | ||
| 84 | On Solaris it is also possible to use either GCC or Solaris Studio | 84 | On Solaris it is also possible to use either GCC or Oracle Developer |
| 85 | to build Emacs, by pointing ./configure to the right compiler: | 85 | Studio to build Emacs, by pointing ./configure to the right compiler: |
| 86 | 86 | ||
| 87 | ./configure CC='/usr/sfw/bin/gcc' # GCC | 87 | ./configure # Defaults to 'gcc' if available. |
| 88 | ./configure CC='cc' # Solaris Studio | 88 | ./configure CC='cc' # Oracle Developer Studio |
| 89 | 89 | ||
| 90 | On Solaris, do not use /usr/ucb/cc. Use /opt/SUNWspro/bin/cc. Make | 90 | On Solaris, do not use /usr/ucb/cc. Use Oracle Developer Studio. |
| 91 | sure that /usr/ccs/bin and /opt/SUNWspro/bin are in your PATH before | 91 | Make sure that /usr/ccs/bin and the Oracle Developer Studio bin |
| 92 | /usr/ucb. (Most free software packages have the same requirement on | 92 | directory (e.g., /opt/developerstudio12.6/bin) are in your PATH |
| 93 | Solaris.) With this compiler, use '/opt/SUNWspro/bin/cc -E' as the | 93 | before /usr/ucb. (Most free software packages have the same |
| 94 | requirement on Solaris.) With this compiler, use 'cc -E' as the | ||
| 94 | preprocessor. If this inserts extra whitespace into its output (see | 95 | preprocessor. If this inserts extra whitespace into its output (see |
| 95 | the PROBLEMS file) then add the option '-Xs'. | 96 | the PROBLEMS file), add the option '-Xs'. |
| 96 | 97 | ||
| 97 | To build a 64-bit Emacs (with larger maximum buffer size) on a | 98 | To build a 64-bit Emacs (with larger maximum buffer size) on a |
| 98 | Solaris system which supports 64-bit executables, specify the -m64 | 99 | Solaris system that defaults to 32-bit executables, specify the -m64 |
| 99 | compiler option. For example: | 100 | compiler option. For example: |
| 100 | 101 | ||
| 101 | ./configure CC='/usr/sfw/bin/gcc -m64' # GCC | 102 | ./configure CC='gcc -m64' # GCC |
| 102 | ./configure CC='cc -m64' # Solaris Studio | 103 | ./configure CC='cc -m64' # Oracle Developer Studio |
| 103 | 104 | ||
| 104 | 105 | ||
| 105 | * Obsolete platforms | 106 | * Obsolete platforms |
| @@ -59,6 +59,11 @@ shaping, so 'configure' now recommends that combination. | |||
| 59 | It was declared obsolete in Emacs 27.1. | 59 | It was declared obsolete in Emacs 27.1. |
| 60 | 60 | ||
| 61 | --- | 61 | --- |
| 62 | ** Support for building with '-fcheck-pointer-bounds' has been removed. | ||
| 63 | GCC has withdrawn the '-fcheck-pointer-bounds' option and support for | ||
| 64 | its implementation has been removed from the Linux kernel. | ||
| 65 | |||
| 66 | --- | ||
| 62 | ** Emacs no longer supports old OpenBSD systems. | 67 | ** Emacs no longer supports old OpenBSD systems. |
| 63 | OpenBSD 5.3 and older releases are no longer supported, as they lack | 68 | OpenBSD 5.3 and older releases are no longer supported, as they lack |
| 64 | proper pty support that Emacs needs. | 69 | proper pty support that Emacs needs. |
| @@ -75,6 +80,11 @@ useful on systems such as FreeBSD which ships only with "etc/termcap". | |||
| 75 | 80 | ||
| 76 | * Changes in Emacs 28.1 | 81 | * Changes in Emacs 28.1 |
| 77 | 82 | ||
| 83 | +++ | ||
| 84 | ** The new constants 'shell-command-buffer-name' and | ||
| 85 | 'shell-command-buffer-name-async' store the default buffer names | ||
| 86 | for the output of shell commands. | ||
| 87 | |||
| 78 | ** Support for '(box . SIZE)' 'cursor-type'. | 88 | ** Support for '(box . SIZE)' 'cursor-type'. |
| 79 | By default, 'box' cursor always has a filled box shape. But if you | 89 | By default, 'box' cursor always has a filled box shape. But if you |
| 80 | specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow | 90 | specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow |
| @@ -117,6 +127,11 @@ horizontal movements now stop at the edge of the board. | |||
| 117 | ** Autosaving via 'auto-save-visited-mode' can now be inhibited by | 127 | ** Autosaving via 'auto-save-visited-mode' can now be inhibited by |
| 118 | setting the variable 'auto-save-visited-mode' buffer-locally to nil. | 128 | setting the variable 'auto-save-visited-mode' buffer-locally to nil. |
| 119 | 129 | ||
| 130 | ** New commands to describe buttons and widgets have been added. | ||
| 131 | 'widget-describe' (on a widget) will pop up a help buffer and give a | ||
| 132 | description of the properties. Likewise 'button-describe' does the | ||
| 133 | same for a button. | ||
| 134 | |||
| 120 | 135 | ||
| 121 | * Changes in Specialized Modes and Packages in Emacs 28.1 | 136 | * Changes in Specialized Modes and Packages in Emacs 28.1 |
| 122 | 137 | ||
| @@ -170,6 +185,11 @@ and variables. | |||
| 170 | 'archive-hideshow-column'. These let you control which columns are | 185 | 'archive-hideshow-column'. These let you control which columns are |
| 171 | displayed and which are kept hidden. | 186 | displayed and which are kept hidden. |
| 172 | 187 | ||
| 188 | --- | ||
| 189 | *** New command bound to 'C': 'archive-copy-file' | ||
| 190 | This command extracts the file under point and writes the data to a | ||
| 191 | file. | ||
| 192 | |||
| 173 | ** Emacs Lisp mode | 193 | ** Emacs Lisp mode |
| 174 | 194 | ||
| 175 | *** The mode-line now indicates whether we're using lexical or dynamic scoping. | 195 | *** The mode-line now indicates whether we're using lexical or dynamic scoping. |
| @@ -179,6 +199,13 @@ The presence of a space between an open paren and a symbol now is | |||
| 179 | taken as a statement by the programmer that this should be indented | 199 | taken as a statement by the programmer that this should be indented |
| 180 | as a data list rather than as a piece of code. | 200 | as a data list rather than as a piece of code. |
| 181 | 201 | ||
| 202 | ** Calendar | ||
| 203 | |||
| 204 | *** New variable 'calendar-use-numeric-time-zones' to use numeric time zones. | ||
| 205 | If non-nil, functions that display time zones (like the 'S' command in | ||
| 206 | calendar mode that displays the sunrise time) will display time zones | ||
| 207 | like "+0100" instead of "CET". | ||
| 208 | |||
| 182 | ** Dired | 209 | ** Dired |
| 183 | 210 | ||
| 184 | *** New user option 'dired-mark-region' affects all Dired commands | 211 | *** New user option 'dired-mark-region' affects all Dired commands |
| @@ -205,6 +232,15 @@ their 'default-directory' under VC. | |||
| 205 | *** Support for bookmark.el. | 232 | *** Support for bookmark.el. |
| 206 | Bookmark locations can refer to VC directory buffers. | 233 | Bookmark locations can refer to VC directory buffers. |
| 207 | 234 | ||
| 235 | --- | ||
| 236 | *** New user option 'vc-hg-create-bookmark' controls whether a bookmark | ||
| 237 | or branch will be created when you invoke 'C-u C-x v s' ('vc-create-tag'). | ||
| 238 | |||
| 239 | --- | ||
| 240 | *** 'vc-hg' now uses 'hg summary' command to populate extra 'vc-dir' | ||
| 241 | headers. | ||
| 242 | |||
| 243 | |||
| 208 | ** Gnus | 244 | ** Gnus |
| 209 | 245 | ||
| 210 | --- | 246 | --- |
| @@ -223,6 +259,40 @@ The names of the commands 'gnus-slave', 'gnus-slave-no-server' and | |||
| 223 | *** The 'W Q' summary mode command now takes a numerical prefix to | 259 | *** The 'W Q' summary mode command now takes a numerical prefix to |
| 224 | allow adjusting the fill width. | 260 | allow adjusting the fill width. |
| 225 | 261 | ||
| 262 | +++ | ||
| 263 | *** New variable 'mm-inline-font-lock'. | ||
| 264 | This variable is supposed to be bound by callers to determine whether | ||
| 265 | inline MIME parts (that support it) are supposed to be font-locked or | ||
| 266 | not. | ||
| 267 | |||
| 268 | ** Message | ||
| 269 | |||
| 270 | +++ | ||
| 271 | *** Message now supports the OpenPGP header. | ||
| 272 | To generate these headers, add the new function | ||
| 273 | 'message-add-openpgp-header' to 'message-send-hook'. The header will | ||
| 274 | be generated according to the new 'message-openpgp-header' variable. | ||
| 275 | |||
| 276 | --- | ||
| 277 | *** A change to how Mail-Copies-To: never is handled. | ||
| 278 | If a user has specified Mail-Copies-To: never, and Message was asked | ||
| 279 | to do a "wide reply", some other arbitrary recipient would end up in | ||
| 280 | the resulting To header, while the remaining recipients would be put | ||
| 281 | in the Cc header. This is somewhat misleading, as it looks like | ||
| 282 | you're responding to a specific person in particular. This has been | ||
| 283 | changed so that all the recipients are put in the To header in these | ||
| 284 | instances. | ||
| 285 | |||
| 286 | +++ | ||
| 287 | *** New function to start Emacs in Message mode to send an email. | ||
| 288 | Emacs can be defined as a handler for the "x-scheme-handler/mailto" | ||
| 289 | MIME type with the following command: "emacs -f message-mailto %u". | ||
| 290 | An emacs-mail.desktop file has been included, suitable for installing | ||
| 291 | in desktop directories like /usr/share/applications. Clicking on a | ||
| 292 | mailto: link in other applications will then open Emacs with headers | ||
| 293 | filled out according to the link, e.g. | ||
| 294 | "mailto:larsi@gnus.org?subject=This+is+a+test". | ||
| 295 | |||
| 226 | --- | 296 | --- |
| 227 | *** Change to default value of 'message-draft-headers' user option. | 297 | *** Change to default value of 'message-draft-headers' user option. |
| 228 | The 'Date' symbol has been removed from the default value, meaning that | 298 | The 'Date' symbol has been removed from the default value, meaning that |
| @@ -231,6 +301,12 @@ was sent. To restore the original behavior of dating a message | |||
| 231 | from when it is first saved or delayed, add the symbol 'Date' back to | 301 | from when it is first saved or delayed, add the symbol 'Date' back to |
| 232 | this user option. | 302 | this user option. |
| 233 | 303 | ||
| 304 | +++ | ||
| 305 | *** New command to take screenshots. | ||
| 306 | In Message mode buffers, the 'C-c C-p' ('message-insert-screenshot') | ||
| 307 | command has been added. It depends on using an external program to | ||
| 308 | take the actual screenshot, and defaults to ImageMagick "import". | ||
| 309 | |||
| 234 | ** Help | 310 | ** Help |
| 235 | 311 | ||
| 236 | +++ | 312 | +++ |
| @@ -260,6 +336,10 @@ To revert to the previous behaviour, | |||
| 260 | unconditionally aborts the current edebug instrumentation with the | 336 | unconditionally aborts the current edebug instrumentation with the |
| 261 | supplied error message. | 337 | supplied error message. |
| 262 | 338 | ||
| 339 | *** Edebug specification lists can use the new keyword ':unique', | ||
| 340 | which appends a unique suffix to the Edebug name of the current | ||
| 341 | definition. | ||
| 342 | |||
| 263 | +++ | 343 | +++ |
| 264 | ** ElDoc | 344 | ** ElDoc |
| 265 | 345 | ||
| @@ -314,6 +394,16 @@ This command marks a remote directory to contain only encrypted files. | |||
| 314 | See the "(tramp) Keeping files encrypted" node of the Tramp manual for | 394 | See the "(tramp) Keeping files encrypted" node of the Tramp manual for |
| 315 | details. This feature is experimental. | 395 | details. This feature is experimental. |
| 316 | 396 | ||
| 397 | +++ | ||
| 398 | *** Support of direct asynchronous process invocation. | ||
| 399 | When Tramp connection property "direct-async-process" is set to | ||
| 400 | non-nil for a given connection, 'make-process' and 'start-file-process' | ||
| 401 | calls are performed directly as in "ssh ... <command>". This avoids | ||
| 402 | initialization performance penalties. See the "(tramp) Improving | ||
| 403 | performance of asynchronous remote processes" node of the Tramp manual | ||
| 404 | for details, and also for a discussion or restrictions. This feature | ||
| 405 | is experimental. | ||
| 406 | |||
| 317 | ** Tempo | 407 | ** Tempo |
| 318 | 408 | ||
| 319 | --- | 409 | --- |
| @@ -398,6 +488,14 @@ to substitute spaces in regexp search. | |||
| 398 | *** The default value of 'hi-lock-highlight-range' was enlarged. | 488 | *** The default value of 'hi-lock-highlight-range' was enlarged. |
| 399 | The new default value is 2000000 (2 megabytes). | 489 | The new default value is 2000000 (2 megabytes). |
| 400 | 490 | ||
| 491 | ** Whitespace mode | ||
| 492 | |||
| 493 | +++ | ||
| 494 | *** New style 'missing-newline-at-eof'. | ||
| 495 | If present in 'whitespace-style' (as it is by default), the final | ||
| 496 | character in the buffer will be highlighted if the buffer doesn't end | ||
| 497 | with a newline. | ||
| 498 | |||
| 401 | ** Texinfo | 499 | ** Texinfo |
| 402 | 500 | ||
| 403 | --- | 501 | --- |
| @@ -476,6 +574,9 @@ either an internal or external browser. | |||
| 476 | 574 | ||
| 477 | *** Support for the conkeror browser is now obsolete. | 575 | *** Support for the conkeror browser is now obsolete. |
| 478 | 576 | ||
| 577 | *** Support for the Mosaic browser has been removed. | ||
| 578 | This support has been obsolete since 25.1. | ||
| 579 | |||
| 479 | ** SHR | 580 | ** SHR |
| 480 | 581 | ||
| 481 | --- | 582 | --- |
| @@ -505,9 +606,24 @@ took more than two seconds to display. The new algorithm maintains a | |||
| 505 | decaying average of delays, and if this number gets too high, the | 606 | decaying average of delays, and if this number gets too high, the |
| 506 | animation is stopped. | 607 | animation is stopped. |
| 507 | 608 | ||
| 609 | +++ | ||
| 610 | *** The 'n' and 'p' commands (next/previous image) now respects dired order. | ||
| 611 | These commands would previously display the next/previous image in | ||
| 612 | alphabetical order, but will now find the "parent" dired buffer and | ||
| 613 | select the next/previous image file according to how the files are | ||
| 614 | sorted there. The commands have also been extended to work when the | ||
| 615 | "parent" buffer is an archive mode (i.e., zip file or the like) or tar | ||
| 616 | mode buffer. | ||
| 617 | |||
| 508 | ** EWW | 618 | ** EWW |
| 509 | 619 | ||
| 510 | +++ | 620 | +++ |
| 621 | *** New Emacs command line convenience function. | ||
| 622 | The 'eww-browse' command has been added, which allows you to register | ||
| 623 | Emacs as a MIME handler for "text/x-uri", and will call eww on the | ||
| 624 | supplied URL. Usage example: emacs -f eww-browse https://gnu.org | ||
| 625 | |||
| 626 | +++ | ||
| 511 | *** 'eww-download-directory' will now use the XDG location, if defined. | 627 | *** 'eww-download-directory' will now use the XDG location, if defined. |
| 512 | However, if "~/Downloads/" already exists, that will continue to be | 628 | However, if "~/Downloads/" already exists, that will continue to be |
| 513 | used. | 629 | used. |
| @@ -565,6 +681,12 @@ Previously 'xml-print' would produce invalid XML when given a string | |||
| 565 | with characters that are not valid in XML (see | 681 | with characters that are not valid in XML (see |
| 566 | https://www.w3.org/TR/xml/#charsets). Now it rejects such strings. | 682 | https://www.w3.org/TR/xml/#charsets). Now it rejects such strings. |
| 567 | 683 | ||
| 684 | ** erc | ||
| 685 | |||
| 686 | --- | ||
| 687 | *** The /ignore command will now ask for a timeout to stop ignoring the user. | ||
| 688 | Allowed inputs are seconds or ISO8601-like periods like "1h" or "4h30m". | ||
| 689 | |||
| 568 | ** Battery | 690 | ** Battery |
| 569 | 691 | ||
| 570 | --- | 692 | --- |
| @@ -601,6 +723,34 @@ custom rules, see the variables 'bug-reference-setup-from-vc-alist', | |||
| 601 | 'bug-reference-setup-from-mail-alist', and | 723 | 'bug-reference-setup-from-mail-alist', and |
| 602 | 'bug-reference-setup-from-irc-alist'. | 724 | 'bug-reference-setup-from-irc-alist'. |
| 603 | 725 | ||
| 726 | ** HTML Mode | ||
| 727 | |||
| 728 | --- | ||
| 729 | *** A new skeleton for adding relative URLs has been added. | ||
| 730 | It's bound to the 'C-c C-c f' keystroke, and prompts for a local file | ||
| 731 | name. | ||
| 732 | |||
| 733 | --- | ||
| 734 | ** Recentf | ||
| 735 | The recentf files are no longer backed up. | ||
| 736 | |||
| 737 | |||
| 738 | ** Miscellaneous | ||
| 739 | |||
| 740 | *** The new library hierarchy.el has been added. | ||
| 741 | It's a library to create, query, navigate and display hierarchy | ||
| 742 | structures. | ||
| 743 | |||
| 744 | --- | ||
| 745 | *** The width of the buffer-name column in 'list-buffers' is now dynamic. | ||
| 746 | The width now depends of the width of the window, but will never be | ||
| 747 | wider than the length of the longest buffer name, except that it will | ||
| 748 | never be narrower than 19 characters. | ||
| 749 | |||
| 750 | *** Bookmarks can now be targets for new tabs. | ||
| 751 | When the 'bookmark.el' library is loaded, a customize choice is added | ||
| 752 | to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list. | ||
| 753 | |||
| 604 | 754 | ||
| 605 | * New Modes and Packages in Emacs 28.1 | 755 | * New Modes and Packages in Emacs 28.1 |
| 606 | 756 | ||
| @@ -678,6 +828,11 @@ have now been removed. | |||
| 678 | 828 | ||
| 679 | * Lisp Changes in Emacs 28.1 | 829 | * Lisp Changes in Emacs 28.1 |
| 680 | 830 | ||
| 831 | --- | ||
| 832 | ** New function 'custom-add-choice'. | ||
| 833 | This function can be used by modes to add elements to the | ||
| 834 | 'choice' customization type of a variable. | ||
| 835 | |||
| 681 | +++ | 836 | +++ |
| 682 | ** New function 'file-modes-number-to-symbolic' to convert a numeric | 837 | ** New function 'file-modes-number-to-symbolic' to convert a numeric |
| 683 | file mode specification into symbolic form. | 838 | file mode specification into symbolic form. |
| @@ -706,6 +861,11 @@ optional argument specifying whether to follow symbolic links. | |||
| 706 | ** 'parse-time-string' can now parse ISO 8601 format strings, | 861 | ** 'parse-time-string' can now parse ISO 8601 format strings, |
| 707 | such as "2020-01-15T16:12:21-08:00". | 862 | such as "2020-01-15T16:12:21-08:00". |
| 708 | 863 | ||
| 864 | --- | ||
| 865 | ** The new function 'decoded-time-period' has been added. | ||
| 866 | It interprets a decoded time structure as a period and returns the | ||
| 867 | equivalent period in seconds. | ||
| 868 | |||
| 709 | +++ | 869 | +++ |
| 710 | ** The new function 'dom-remove-attribute' has been added. | 870 | ** The new function 'dom-remove-attribute' has been added. |
| 711 | 871 | ||
diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 4ce738d9a54..598a79f978a 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS | |||
| @@ -2222,6 +2222,7 @@ We list bugs in current versions here. See also the section on legacy | |||
| 2222 | systems. | 2222 | systems. |
| 2223 | 2223 | ||
| 2224 | *** On Solaris 10, Emacs crashes during the build process. | 2224 | *** On Solaris 10, Emacs crashes during the build process. |
| 2225 | (This applies only with './configure --with-unexec=yes', which is rare.) | ||
| 2225 | This was reported for Emacs 25.2 on i386-pc-solaris2.10 with Sun | 2226 | This was reported for Emacs 25.2 on i386-pc-solaris2.10 with Sun |
| 2226 | Studio 12 (Sun C 5.9) and with Oracle Developer Studio 12.6 (Sun C | 2227 | Studio 12 (Sun C 5.9) and with Oracle Developer Studio 12.6 (Sun C |
| 2227 | 5.15), and intermittently for sparc-sun-solaris2.10 with Oracle | 2228 | 5.15), and intermittently for sparc-sun-solaris2.10 with Oracle |
| @@ -2239,66 +2240,6 @@ Solaris. See Bug#26638. | |||
| 2239 | This is a Solaris feature (at least on Intel x86 cpus). Type C-r | 2240 | This is a Solaris feature (at least on Intel x86 cpus). Type C-r |
| 2240 | C-r C-t, to toggle whether C-x gets through to Emacs. | 2241 | C-r C-t, to toggle whether C-x gets through to Emacs. |
| 2241 | 2242 | ||
| 2242 | *** Problem with remote X server on Suns. | ||
| 2243 | |||
| 2244 | On a Sun, running Emacs on one machine with the X server on another | ||
| 2245 | may not work if you have used the unshared system libraries. This | ||
| 2246 | is because the unshared libraries fail to use YP for host name lookup. | ||
| 2247 | As a result, the host name you specify may not be recognized. | ||
| 2248 | |||
| 2249 | *** Solaris 2.6: Emacs crashes with SIGBUS or SIGSEGV on Solaris after you delete a frame. | ||
| 2250 | |||
| 2251 | We suspect that this is a bug in the X libraries provided by | ||
| 2252 | Sun. There is a report that one of these patches fixes the bug and | ||
| 2253 | makes the problem stop: | ||
| 2254 | |||
| 2255 | 105216-01 105393-01 105518-01 105621-01 105665-01 105615-02 105216-02 | ||
| 2256 | 105667-01 105401-08 105615-03 105621-02 105686-02 105736-01 105755-03 | ||
| 2257 | 106033-01 105379-01 105786-01 105181-04 105379-03 105786-04 105845-01 | ||
| 2258 | 105284-05 105669-02 105837-01 105837-02 105558-01 106125-02 105407-01 | ||
| 2259 | |||
| 2260 | Another person using a newer system (kernel patch level Generic_105181-06) | ||
| 2261 | suspects that the bug was fixed by one of these more recent patches: | ||
| 2262 | |||
| 2263 | 106040-07 SunOS 5.6: X Input & Output Method patch | ||
| 2264 | 106222-01 OpenWindows 3.6: filemgr (ff.core) fixes | ||
| 2265 | 105284-12 Motif 1.2.7: sparc Runtime library patch | ||
| 2266 | |||
| 2267 | *** Solaris 7 or 8: Emacs reports a BadAtom error (from X) | ||
| 2268 | |||
| 2269 | This happens when Emacs was built on some other version of Solaris. | ||
| 2270 | Rebuild it on Solaris 8. | ||
| 2271 | |||
| 2272 | *** When using M-x dbx with the SparcWorks debugger, the 'up' and 'down' | ||
| 2273 | commands do not move the arrow in Emacs. | ||
| 2274 | |||
| 2275 | You can fix this by adding the following line to '~/.dbxinit': | ||
| 2276 | |||
| 2277 | dbxenv output_short_file_name off | ||
| 2278 | |||
| 2279 | *** On Solaris, CTRL-t is ignored by Emacs when you use | ||
| 2280 | the fr.ISO-8859-15 locale (and maybe other related locales). | ||
| 2281 | |||
| 2282 | You can fix this by editing the file: | ||
| 2283 | |||
| 2284 | /usr/openwin/lib/locale/iso8859-15/Compose | ||
| 2285 | |||
| 2286 | Near the bottom there is a line that reads: | ||
| 2287 | |||
| 2288 | Ctrl<t> <quotedbl> <Y> : "\276" threequarters | ||
| 2289 | |||
| 2290 | while it should read: | ||
| 2291 | |||
| 2292 | Ctrl<T> <quotedbl> <Y> : "\276" threequarters | ||
| 2293 | |||
| 2294 | Note the lower case <t>. Changing this line should make C-t work. | ||
| 2295 | |||
| 2296 | *** On Solaris, Emacs fails to set menu-bar-update-hook on startup, with error | ||
| 2297 | "Error in menu-bar-update-hook: (error Point before start of properties)". | ||
| 2298 | This seems to be a GCC optimization bug that occurs for GCC 4.1.2 (-g | ||
| 2299 | and -g -O2) and GCC 4.2.3 (-g -O and -g -O2). You can fix this by | ||
| 2300 | compiling with GCC 4.2.3 or CC 5.7, with no optimizations. | ||
| 2301 | |||
| 2302 | * Runtime problems specific to MS-Windows | 2243 | * Runtime problems specific to MS-Windows |
| 2303 | 2244 | ||
| 2304 | ** Emacs on Windows 9X requires UNICOWS.DLL | 2245 | ** Emacs on Windows 9X requires UNICOWS.DLL |
| @@ -2733,13 +2674,13 @@ Libxpm is available for macOS as part of the XQuartz project. | |||
| 2733 | 2674 | ||
| 2734 | This indicates a mismatch between the C compiler and preprocessor that | 2675 | This indicates a mismatch between the C compiler and preprocessor that |
| 2735 | configure is using. For example, on Solaris 10 trying to use | 2676 | configure is using. For example, on Solaris 10 trying to use |
| 2736 | CC=/opt/SUNWspro/bin/cc (the Sun Studio compiler) together with | 2677 | CC=/opt/developerstudio12.6/bin/cc (the Oracle Developer Studio |
| 2737 | CPP=/usr/ccs/lib/cpp can result in errors of this form (you may also | 2678 | compiler) together with CPP=/usr/lib/cpp can result in errors of |
| 2738 | see the error '"/usr/include/sys/isa_defs.h", line 500: undefined control'). | 2679 | this form. |
| 2739 | 2680 | ||
| 2740 | The solution is to tell configure to use the correct C preprocessor | 2681 | The solution is to tell configure to use the correct C preprocessor |
| 2741 | for your C compiler (CPP="/opt/SUNWspro/bin/cc -E" in the above | 2682 | for your C compiler (CPP="/opt/developerstudio12.6/bin/cc -E" in the |
| 2742 | example). | 2683 | above example). |
| 2743 | 2684 | ||
| 2744 | ** Compilation | 2685 | ** Compilation |
| 2745 | 2686 | ||
| @@ -3110,7 +3051,69 @@ This section covers bugs reported on very old hardware or software. | |||
| 3110 | If you are using hardware and an operating system shipped after 2000, | 3051 | If you are using hardware and an operating system shipped after 2000, |
| 3111 | it is unlikely you will see any of these. | 3052 | it is unlikely you will see any of these. |
| 3112 | 3053 | ||
| 3113 | *** Solaris 2.x | 3054 | ** Solaris |
| 3055 | |||
| 3056 | *** Problem with remote X server on Suns. | ||
| 3057 | |||
| 3058 | On a Sun, running Emacs on one machine with the X server on another | ||
| 3059 | may not work if you have used the unshared system libraries. This | ||
| 3060 | is because the unshared libraries fail to use YP for host name lookup. | ||
| 3061 | As a result, the host name you specify may not be recognized. | ||
| 3062 | |||
| 3063 | *** Solaris 2.6: Emacs crashes with SIGBUS or SIGSEGV on Solaris after you delete a frame. | ||
| 3064 | |||
| 3065 | We suspect that this is a bug in the X libraries provided by | ||
| 3066 | Sun. There is a report that one of these patches fixes the bug and | ||
| 3067 | makes the problem stop: | ||
| 3068 | |||
| 3069 | 105216-01 105393-01 105518-01 105621-01 105665-01 105615-02 105216-02 | ||
| 3070 | 105667-01 105401-08 105615-03 105621-02 105686-02 105736-01 105755-03 | ||
| 3071 | 106033-01 105379-01 105786-01 105181-04 105379-03 105786-04 105845-01 | ||
| 3072 | 105284-05 105669-02 105837-01 105837-02 105558-01 106125-02 105407-01 | ||
| 3073 | |||
| 3074 | Another person using a newer system (kernel patch level Generic_105181-06) | ||
| 3075 | suspects that the bug was fixed by one of these more recent patches: | ||
| 3076 | |||
| 3077 | 106040-07 SunOS 5.6: X Input & Output Method patch | ||
| 3078 | 106222-01 OpenWindows 3.6: filemgr (ff.core) fixes | ||
| 3079 | 105284-12 Motif 1.2.7: sparc Runtime library patch | ||
| 3080 | |||
| 3081 | *** Solaris 7 or 8: Emacs reports a BadAtom error (from X) | ||
| 3082 | |||
| 3083 | This happens when Emacs was built on some other version of Solaris. | ||
| 3084 | Rebuild it on Solaris 8. | ||
| 3085 | |||
| 3086 | *** When using M-x dbx with the SparcWorks debugger, the 'up' and 'down' | ||
| 3087 | commands do not move the arrow in Emacs. | ||
| 3088 | |||
| 3089 | You can fix this by adding the following line to '~/.dbxinit': | ||
| 3090 | |||
| 3091 | dbxenv output_short_file_name off | ||
| 3092 | |||
| 3093 | *** On Solaris, CTRL-t is ignored by Emacs when you use | ||
| 3094 | the fr.ISO-8859-15 locale (and maybe other related locales). | ||
| 3095 | |||
| 3096 | You can fix this by editing the file: | ||
| 3097 | |||
| 3098 | /usr/openwin/lib/locale/iso8859-15/Compose | ||
| 3099 | |||
| 3100 | Near the bottom there is a line that reads: | ||
| 3101 | |||
| 3102 | Ctrl<t> <quotedbl> <Y> : "\276" threequarters | ||
| 3103 | |||
| 3104 | while it should read: | ||
| 3105 | |||
| 3106 | Ctrl<T> <quotedbl> <Y> : "\276" threequarters | ||
| 3107 | |||
| 3108 | Note the lower case <t>. Changing this line should make C-t work. | ||
| 3109 | |||
| 3110 | *** On Solaris, Emacs fails to set menu-bar-update-hook on startup, with error | ||
| 3111 | "Error in menu-bar-update-hook: (error Point before start of properties)". | ||
| 3112 | This seems to be a GCC optimization bug that occurs for GCC 4.1.2 (-g | ||
| 3113 | and -g -O2) and GCC 4.2.3 (-g -O and -g -O2). You can fix this by | ||
| 3114 | compiling with GCC 4.2.3 or CC 5.7, with no optimizations. | ||
| 3115 | |||
| 3116 | *** Other legacy Solaris problems | ||
| 3114 | 3117 | ||
| 3115 | **** Strange results from format %d in a few cases, on a Sun. | 3118 | **** Strange results from format %d in a few cases, on a Sun. |
| 3116 | 3119 | ||
diff --git a/etc/emacs-mail.desktop b/etc/emacs-mail.desktop new file mode 100644 index 00000000000..3a96b9ec8c7 --- /dev/null +++ b/etc/emacs-mail.desktop | |||
| @@ -0,0 +1,10 @@ | |||
| 1 | [Desktop Entry] | ||
| 2 | Categories=Network;Email; | ||
| 3 | Comment=GNU Emacs is an extensible, customizable text editor - and more | ||
| 4 | Exec=emacs -f message-mailto %u | ||
| 5 | Icon=emacs | ||
| 6 | Name=Emacs (Mail) | ||
| 7 | MimeType=x-scheme-handler/mailto; | ||
| 8 | NoDisplay=false | ||
| 9 | Terminal=false | ||
| 10 | Type=Application | ||
diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el index c298b536d2d..f104c845ff6 100644 --- a/etc/themes/leuven-theme.el +++ b/etc/themes/leuven-theme.el | |||
| @@ -4,7 +4,7 @@ | |||
| 4 | 4 | ||
| 5 | ;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> | 5 | ;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")> |
| 6 | ;; URL: https://github.com/fniessen/emacs-leuven-theme | 6 | ;; URL: https://github.com/fniessen/emacs-leuven-theme |
| 7 | ;; Version: 20200425.0837 | 7 | ;; Version: 20200513.1928 |
| 8 | ;; Keywords: color theme | 8 | ;; Keywords: color theme |
| 9 | 9 | ||
| 10 | ;; This file is part of GNU Emacs. | 10 | ;; This file is part of GNU Emacs. |
| @@ -31,42 +31,98 @@ | |||
| 31 | ;; | 31 | ;; |
| 32 | ;; (load-theme 'leuven t) | 32 | ;; (load-theme 'leuven t) |
| 33 | ;; | 33 | ;; |
| 34 | ;; Requirements: Emacs 24. | 34 | ;; Requirements: Emacs 24+. |
| 35 | ;; | ||
| 36 | ;; NOTE -- Would you like implement a version of this for dark backgrounds, | ||
| 37 | ;; please do so! I'm willing to integrate it... | ||
| 35 | 38 | ||
| 36 | ;;; Code: | 39 | ;;; Code: |
| 37 | 40 | ||
| 41 | ;;; Options. | ||
| 42 | |||
| 43 | (defgroup leuven nil | ||
| 44 | "Leuven theme options. | ||
| 45 | The theme has to be reloaded after changing anything in this group." | ||
| 46 | :group 'faces) | ||
| 47 | |||
| 48 | (defcustom leuven-scale-outline-headlines t | ||
| 49 | "Scale `outline' (and `org') level-1 headlines. | ||
| 50 | This can be nil for unscaled, t for using the theme default, or a scaling | ||
| 51 | number." | ||
| 52 | :type '(choice | ||
| 53 | (const :tag "Unscaled" nil) | ||
| 54 | (const :tag "Default provided by theme" t) | ||
| 55 | (number :tag "Set scaling")) | ||
| 56 | :group 'leuven) | ||
| 57 | |||
| 58 | (defcustom leuven-scale-org-agenda-structure t | ||
| 59 | "Scale Org agenda structure lines, like dates. | ||
| 60 | This can be nil for unscaled, t for using the theme default, or a scaling | ||
| 61 | number." | ||
| 62 | :type '(choice | ||
| 63 | (const :tag "Unscaled" nil) | ||
| 64 | (const :tag "Default provided by theme" t) | ||
| 65 | (number :tag "Set scaling"))) | ||
| 66 | |||
| 67 | (defun leuven-scale-font (control default-height) | ||
| 68 | "Function for splicing optional font heights into face descriptions. | ||
| 69 | CONTROL can be a number, nil, or t. When t, use DEFAULT-HEIGHT." | ||
| 70 | (cond | ||
| 71 | ((numberp control) (list :height control)) | ||
| 72 | ((eq t control) (list :height default-height)) | ||
| 73 | (t nil))) | ||
| 74 | |||
| 75 | ;;; Theme Faces. | ||
| 76 | |||
| 38 | (deftheme leuven | 77 | (deftheme leuven |
| 39 | "Face colors with a light background. | 78 | "Face colors with a light background. |
| 40 | Basic, Font Lock, Isearch, Gnus, Message, Diff, Ediff, Flyspell, | 79 | Basic, Font Lock, Isearch, Gnus, Message, Org mode, Diff, Ediff, |
| 41 | Semantic, and Ansi-Color faces are included -- and much more...") | 80 | Flyspell, Semantic, and Ansi-Color faces are included -- and much |
| 81 | more...") | ||
| 42 | 82 | ||
| 43 | (let ((class '((class color) (min-colors 89))) | 83 | (let ((class '((class color) (min-colors 89))) |
| 44 | 84 | ||
| 45 | ;; Leuven generic colors | 85 | ;; Leuven generic colors. |
| 46 | (cancel '(:slant italic :strike-through t :foreground "gray55")) | 86 | (cancel '(:slant italic :strike-through t :foreground "#A9A9A9")) |
| 47 | (clock-line '(:box (:line-width 1 :color "#335EA8") :foreground "black" :background "#EEC900")) | 87 | (clock-line '(:box (:line-width 1 :color "#335EA8") :foreground "black" :background "#EEC900")) |
| 48 | (code-block '(:foreground "#000088" :background "#FFFFE0")) | 88 | (code-block '(:foreground "#000088" :background "#FFFFE0")) |
| 49 | (code-inline '(:foreground "#006400" :background "#FDFFF7")) | 89 | (code-inline '(:foreground "#006400" :background "#FDFFF7")) |
| 50 | (column '(:height 1.0 :weight normal :slant normal :underline nil :strike-through nil :foreground "#E6AD4F" :background "#FFF2DE")) | 90 | (column '(:height 1.0 :weight normal :slant normal :underline nil :strike-through nil :foreground "#E6AD4F" :background "#FFF2DE")) |
| 51 | (diff-added '(:foreground "#008000" :background "#DDFFDD")) | 91 | (completion-inline '(:weight normal :foreground "#C0C0C0" :inherit hl-line)) ; Like Google. |
| 92 | (completion-other-candidates '(:weight bold :foreground "black" :background "#EBF4FE")) | ||
| 93 | (completion-selected-candidate '(:weight bold :foreground "white" :background "#0052A4")) | ||
| 94 | (diff-added '(:background "#DDFFDD")) | ||
| 52 | (diff-changed '(:foreground "#0000FF" :background "#DDDDFF")) | 95 | (diff-changed '(:foreground "#0000FF" :background "#DDDDFF")) |
| 53 | (diff-header '(:foreground "#800000" :background "#FFFFAF")) | 96 | (diff-header '(:weight bold :foreground "#800000" :background "#FFFFAF")) |
| 54 | (diff-hunk-header '(:foreground "#990099" :background "#FFEEFF")) | 97 | (diff-hunk-header '(:foreground "#990099" :background "#FFEEFF")) |
| 55 | (diff-none '(:foreground "gray33")) | 98 | (diff-none '(:foreground "#888888")) |
| 56 | (diff-removed '(:foreground "#A60000" :background "#FFDDDD")) | 99 | (diff-refine-added '(:background "#97F295")) |
| 100 | (diff-refine-removed '(:background "#FFB6BA")) | ||
| 101 | (diff-removed '(:background "#FEE8E9")) | ||
| 57 | (directory '(:weight bold :foreground "blue" :background "#FFFFD2")) | 102 | (directory '(:weight bold :foreground "blue" :background "#FFFFD2")) |
| 58 | (highlight-line '(:background "#FFFFD7")) ; #F5F5F5 | 103 | (file '(:foreground "black")) |
| 59 | (highlight-line-gnus '(:background "#DAEAFC")) ; defined in `gnus-leuven.el' | 104 | (function-param '(:foreground "#247284")) |
| 105 | (grep-file-name '(:weight bold :foreground "#2A489E")) ; Used for grep hits. | ||
| 106 | (grep-line-number '(:weight bold :foreground "#A535AE")) | ||
| 107 | (highlight-blue '(:background "#E6ECFF")) | ||
| 108 | (highlight-blue2 '(:background "#E4F1F9")) | ||
| 109 | (highlight-gray '(:background "#E4E4E3")) | ||
| 110 | (highlight-green '(:background "#D5F1CF")) | ||
| 111 | (highlight-red '(:background "#FFC8C8")) | ||
| 112 | (highlight-yellow '(:background "#F6FECD")) | ||
| 60 | (link '(:weight normal :underline t :foreground "#006DAF")) | 113 | (link '(:weight normal :underline t :foreground "#006DAF")) |
| 114 | (link-no-underline '(:weight normal :foreground "#006DAF")) | ||
| 61 | (mail-header-name '(:family "Sans Serif" :weight normal :foreground "#A3A3A2")) | 115 | (mail-header-name '(:family "Sans Serif" :weight normal :foreground "#A3A3A2")) |
| 62 | (mail-header-other '(:family "Sans Serif" :slant normal :foreground "#666666")) | 116 | (mail-header-other '(:family "Sans Serif" :slant normal :foreground "#666666")) |
| 63 | (mail-read '(:weight normal :foreground "#86878B")) | 117 | (mail-read '(:foreground "#8C8C8C")) |
| 64 | (mail-ticked '(:weight bold :background "#FBE6EF")) | 118 | (mail-read-high '(:foreground "#808080")) |
| 119 | (mail-ticked '(:foreground "#FF3300")) | ||
| 65 | (mail-to '(:family "Sans Serif" :underline nil :foreground "#006DAF")) | 120 | (mail-to '(:family "Sans Serif" :underline nil :foreground "#006DAF")) |
| 66 | (mail-unread '(:weight bold :foreground "black")) | 121 | (mail-unread '(:weight bold :foreground "#000000")) |
| 67 | (marked-line '(:weight bold :foreground "white" :background "red")) | 122 | (mail-unread-high '(:weight bold :foreground "#135985")) |
| 68 | (match '(:weight bold :background "#FBE448")) ; occur patterns | 123 | (marked-line '(:foreground "#AA0000" :background "#FFAAAA")) |
| 69 | (ol1 '(:height 1.3 :weight bold :overline "#A7A7A7" :foreground "#3C3C3C" :background "#F0F0F0")) | 124 | (match '(:weight bold :background "#FFFF00")) ; occur patterns + match in helm for files + match in Org files. |
| 125 | (ol1 `(,@(leuven-scale-font leuven-scale-outline-headlines 1.3) :weight bold :overline "#A7A7A7" :foreground "#3C3C3C" :background "#F0F0F0")) | ||
| 70 | (ol2 '(:height 1.0 :weight bold :overline "#123555" :foreground "#123555" :background "#E5F4FB")) | 126 | (ol2 '(:height 1.0 :weight bold :overline "#123555" :foreground "#123555" :background "#E5F4FB")) |
| 71 | (ol3 '(:height 1.0 :weight bold :foreground "#005522" :background "#EFFFEF")) | 127 | (ol3 '(:height 1.0 :weight bold :foreground "#005522" :background "#EFFFEF")) |
| 72 | (ol4 '(:height 1.0 :weight bold :slant normal :foreground "#EA6300")) | 128 | (ol4 '(:height 1.0 :weight bold :slant normal :foreground "#EA6300")) |
| @@ -74,15 +130,22 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 74 | (ol6 '(:height 1.0 :weight bold :slant italic :foreground "#0077CC")) | 130 | (ol6 '(:height 1.0 :weight bold :slant italic :foreground "#0077CC")) |
| 75 | (ol7 '(:height 1.0 :weight bold :slant italic :foreground "#2EAE2C")) | 131 | (ol7 '(:height 1.0 :weight bold :slant italic :foreground "#2EAE2C")) |
| 76 | (ol8 '(:height 1.0 :weight bold :slant italic :foreground "#FD8008")) | 132 | (ol8 '(:height 1.0 :weight bold :slant italic :foreground "#FD8008")) |
| 77 | (paren-matched '(:background "#99CCFF")) | 133 | (paren-matched '(:background "#C0E8C3")) ; Or take that green for region? |
| 78 | (paren-unmatched '(:underline "red" :foreground nil :background "#FFDCDC")) | 134 | (paren-unmatched '(:weight bold :underline "red" :foreground "black" :background "#FFA5A5")) |
| 79 | (region '(:background "#ABDFFA")) | 135 | (region '(:background "#8ED3FF")) |
| 80 | (shadow '(:foreground "#7F7F7F")) | 136 | (shadow '(:foreground "#7F7F7F")) |
| 81 | (string '(:foreground "#008000")) ; or #D0372D | 137 | (string '(:foreground "#008000")) ; or #D0372D |
| 82 | (subject '(:family "Sans Serif" :weight bold :foreground "black")) | 138 | (subject '(:family "Sans Serif" :weight bold :foreground "black")) |
| 83 | (symlink '(:foreground "deep sky blue")) | 139 | (symlink '(:foreground "#1F8DD6")) |
| 84 | (volatile-highlight '(:underline nil :background "#FFF876")) | 140 | (tab '(:foreground "#E8E8E8" :background "white")) |
| 85 | (vc-branch '(:box (:line-width 1 :color "#00CC33") :foreground "black" :background "#AAFFAA"))) | 141 | (trailing '(:foreground "#E8E8E8" :background "#FFFFAB")) |
| 142 | (volatile-highlight '(:underline nil :foreground "white" :background "#9E3699")) | ||
| 143 | (volatile-highlight-supersize '(:height 1.1 :underline nil :foreground "white" :background "#9E3699")) ; flash-region | ||
| 144 | (vc-branch '(:box (:line-width 1 :color "#00CC33") :foreground "black" :background "#AAFFAA")) | ||
| 145 | (xml-attribute '(:foreground "#F36335")) | ||
| 146 | (xml-tag '(:foreground "#AE1B9A")) | ||
| 147 | (highlight-current-tag '(:background "#E8E8FF")) ; #EEF3F6 or #FFEB26 | ||
| 148 | ) | ||
| 86 | 149 | ||
| 87 | (custom-theme-set-faces | 150 | (custom-theme-set-faces |
| 88 | 'leuven | 151 | 'leuven |
| @@ -91,40 +154,43 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 91 | `(bold-italic ((,class (:weight bold :slant italic :foreground "black")))) | 154 | `(bold-italic ((,class (:weight bold :slant italic :foreground "black")))) |
| 92 | `(italic ((,class (:slant italic :foreground "#1A1A1A")))) | 155 | `(italic ((,class (:slant italic :foreground "#1A1A1A")))) |
| 93 | `(underline ((,class (:underline t)))) | 156 | `(underline ((,class (:underline t)))) |
| 94 | `(cursor ((,class (:background "#0FB300")))) | 157 | `(cursor ((,class (:background "#21BDFF")))) |
| 158 | |||
| 159 | ;; Lucid toolkit emacs menus. | ||
| 160 | `(menu ((,class (:foreground "#FFFFFF" :background "#333333")))) | ||
| 95 | 161 | ||
| 96 | ;; Highlighting faces | 162 | ;; Highlighting faces. |
| 97 | `(fringe ((,class (:foreground "#9B9B9B" :background "#EDEDED")))) | 163 | `(fringe ((,class (:foreground "#4C9ED9" :background "white")))) |
| 98 | `(highlight ((,class ,volatile-highlight))) | 164 | `(highlight ((,class ,highlight-blue))) |
| 99 | `(region ((,class ,region))) | 165 | `(region ((,class ,region))) |
| 100 | `(secondary-selection ((,class ,match))) ; used by Org-mode for highlighting matched entries and keywords | 166 | `(secondary-selection ((,class ,match))) ; Used by Org-mode for highlighting matched entries and keywords. |
| 101 | `(isearch ((,class (:weight bold :underline "#FF9632" :foreground nil :background "#FDBD33")))) | 167 | `(isearch ((,class (:underline "black" :foreground "white" :background "#5974AB")))) |
| 102 | `(isearch-fail ((,class (:weight bold :foreground "black" :background "#FF9999")))) | 168 | `(isearch-fail ((,class (:weight bold :foreground "black" :background "#FFCCCC")))) |
| 103 | `(lazy-highlight ((,class (:underline "#FF9632" :background "#FFFF00")))) ; isearch others | 169 | `(lazy-highlight ((,class (:foreground "black" :background "#FFFF00")))) ; Isearch others (see `match'). |
| 104 | `(trailing-whitespace ((,class (:background "#FFFF57")))) | 170 | `(trailing-whitespace ((,class ,trailing))) |
| 105 | `(whitespace-hspace ((,class (:foreground "#D2D2D2")))) | 171 | `(query-replace ((,class (:inherit isearch)))) |
| 106 | `(whitespace-indentation ((,class (:foreground "#A1A1A1" :background "white")))) | 172 | `(whitespace-hspace ((,class (:foreground "#D2D2D2")))) ; see also `nobreak-space' |
| 173 | `(whitespace-indentation ((,class ,tab))) | ||
| 107 | `(whitespace-line ((,class (:foreground "#CC0000" :background "#FFFF88")))) | 174 | `(whitespace-line ((,class (:foreground "#CC0000" :background "#FFFF88")))) |
| 108 | `(whitespace-tab ((,class (:foreground "#A1A1A1" :background "white")))) | 175 | `(whitespace-tab ((,class ,tab))) |
| 109 | `(whitespace-trailing ((,class (:foreground "#B3B3B3" :background "#FFFF57")))) | 176 | `(whitespace-trailing ((,class ,trailing))) |
| 110 | 177 | ||
| 111 | ;; Mode line faces | 178 | ;; Mode line faces. |
| 112 | `(mode-line ((,class (:box (:line-width 1 :color "#1A2F54") :foreground "#85CEEB" :background "#335EA8")))) | 179 | `(mode-line ((,class (:box (:line-width 1 :color "#1A2F54") :foreground "#85CEEB" :background "#335EA8")))) |
| 113 | `(mode-line-inactive ((,class (:box (:line-width 1 :color "#4E4E4C") :foreground "#F0F0EF" :background "#9B9C97")))) | 180 | `(mode-line-inactive ((,class (:box (:line-width 1 :color "#4E4E4C") :foreground "#F0F0EF" :background "#9B9C97")))) |
| 114 | `(mode-line-buffer-id ((,class (:weight bold :foreground "white")))) | 181 | `(mode-line-buffer-id ((,class (:weight bold :foreground "white")))) |
| 115 | `(mode-line-emphasis ((,class (:weight bold :foreground "white")))) | 182 | `(mode-line-emphasis ((,class (:weight bold :foreground "white")))) |
| 116 | `(mode-line-highlight ((,class (:foreground "yellow")))) | 183 | `(mode-line-highlight ((,class (:foreground "yellow")))) |
| 117 | 184 | ||
| 118 | ;; Escape and prompt faces | 185 | ;; Escape and prompt faces. |
| 119 | `(minibuffer-prompt ((,class (:weight bold :foreground "black" :background "gold")))) | 186 | `(minibuffer-prompt ((,class (:weight bold :foreground "black" :background "gold")))) |
| 120 | `(minibuffer-noticeable-prompt ((,class (:weight bold :foreground "black" :background "gold")))) | 187 | `(minibuffer-noticeable-prompt ((,class (:weight bold :foreground "black" :background "gold")))) |
| 121 | `(escape-glyph ((,class (:foreground "#008ED1")))) | 188 | `(escape-glyph ((,class (:foreground "#008ED1")))) |
| 122 | `(homoglyph ((,class (:foreground "#008ED1")))) | ||
| 123 | `(error ((,class (:foreground "red")))) | 189 | `(error ((,class (:foreground "red")))) |
| 124 | `(warning ((,class (:weight bold :foreground "orange")))) | 190 | `(warning ((,class (:weight bold :foreground "orange")))) |
| 125 | `(success ((,class (:foreground "green")))) | 191 | `(success ((,class (:foreground "green")))) |
| 126 | 192 | ||
| 127 | ;; Font lock faces | 193 | ;; Font lock faces. |
| 128 | `(font-lock-builtin-face ((,class (:foreground "#006FE0")))) | 194 | `(font-lock-builtin-face ((,class (:foreground "#006FE0")))) |
| 129 | `(font-lock-comment-delimiter-face ((,class (:foreground "#8D8D84")))) ; #696969 | 195 | `(font-lock-comment-delimiter-face ((,class (:foreground "#8D8D84")))) ; #696969 |
| 130 | `(font-lock-comment-face ((,class (:slant italic :foreground "#8D8D84")))) ; #696969 | 196 | `(font-lock-comment-face ((,class (:slant italic :foreground "#8D8D84")))) ; #696969 |
| @@ -140,32 +206,32 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 140 | `(font-lock-variable-name-face ((,class (:weight normal :foreground "#BA36A5")))) ; #800080 | 206 | `(font-lock-variable-name-face ((,class (:weight normal :foreground "#BA36A5")))) ; #800080 |
| 141 | `(font-lock-warning-face ((,class (:weight bold :foreground "red")))) | 207 | `(font-lock-warning-face ((,class (:weight bold :foreground "red")))) |
| 142 | 208 | ||
| 143 | ;; Button and link faces | 209 | ;; Button and link faces. |
| 144 | `(link ((,class ,link))) | 210 | `(link ((,class ,link))) |
| 145 | `(link-visited ((,class (:underline t :foreground "#E5786D")))) | 211 | `(link-visited ((,class (:underline t :foreground "#E5786D")))) |
| 146 | `(button ((,class (:underline t :foreground "#006DAF")))) | 212 | `(button ((,class (:underline t :foreground "#006DAF")))) |
| 147 | `(header-line ((,class (:weight bold :underline "black" :overline "black" :foreground "black" :background "#FFFF88")))) | 213 | `(header-line ((,class (:box (:line-width 1 :color "black") :foreground "black" :background "#F0F0F0")))) |
| 148 | 214 | ||
| 149 | ;; Gnus faces | 215 | ;; Gnus faces. |
| 150 | `(gnus-button ((,class (:weight normal)))) | 216 | `(gnus-button ((,class (:weight normal)))) |
| 151 | `(gnus-cite-attribution-face ((,class (:foreground "#5050B0")))) | 217 | `(gnus-cite-attribution-face ((,class (:foreground "#5050B0")))) |
| 152 | `(gnus-cite-face-1 ((,class (:foreground "#5050B0")))) | 218 | `(gnus-cite-1 ((,class (:foreground "#5050B0" :background "#F6F6F6")))) |
| 153 | `(gnus-cite-face-10 ((,class (:foreground "#990000")))) | 219 | `(gnus-cite-2 ((,class (:foreground "#660066" :background "#F6F6F6")))) |
| 154 | `(gnus-cite-face-2 ((,class (:foreground "#660066")))) | 220 | `(gnus-cite-3 ((,class (:foreground "#007777" :background "#F6F6F6")))) |
| 155 | `(gnus-cite-face-3 ((,class (:foreground "#007777")))) | 221 | `(gnus-cite-4 ((,class (:foreground "#990000" :background "#F6F6F6")))) |
| 156 | `(gnus-cite-face-4 ((,class (:foreground "#990000")))) | 222 | `(gnus-cite-5 ((,class (:foreground "#000099" :background "#F6F6F6")))) |
| 157 | `(gnus-cite-face-5 ((,class (:foreground "#000099")))) | 223 | `(gnus-cite-6 ((,class (:foreground "#BB6600" :background "#F6F6F6")))) |
| 158 | `(gnus-cite-face-6 ((,class (:foreground "#BB6600")))) | 224 | `(gnus-cite-7 ((,class (:foreground "#5050B0" :background "#F6F6F6")))) |
| 159 | `(gnus-cite-face-7 ((,class (:foreground "#5050B0")))) | 225 | `(gnus-cite-8 ((,class (:foreground "#660066" :background "#F6F6F6")))) |
| 160 | `(gnus-cite-face-8 ((,class (:foreground "#660066")))) | 226 | `(gnus-cite-9 ((,class (:foreground "#007777" :background "#F6F6F6")))) |
| 161 | `(gnus-cite-face-9 ((,class (:foreground "#007777")))) | 227 | `(gnus-cite-10 ((,class (:foreground "#990000" :background "#F6F6F6")))) |
| 162 | `(gnus-emphasis-bold ((,class (:weight bold)))) | 228 | `(gnus-emphasis-bold ((,class (:weight bold)))) |
| 163 | `(gnus-emphasis-highlight-words ((,class (:foreground "yellow" :background "black")))) | 229 | `(gnus-emphasis-highlight-words ((,class (:foreground "yellow" :background "black")))) |
| 164 | `(gnus-group-mail-1 ((,class (:weight bold :foreground "#FF50B0")))) | 230 | `(gnus-group-mail-1 ((,class (:weight bold :foreground "#FF50B0")))) |
| 165 | `(gnus-group-mail-1-empty ((,class (:foreground "#5050B0")))) | 231 | `(gnus-group-mail-1-empty ((,class (:foreground "#5050B0")))) |
| 166 | `(gnus-group-mail-2 ((,class (:weight bold :foreground "#FF0066")))) | 232 | `(gnus-group-mail-2 ((,class (:weight bold :foreground "#FF0066")))) |
| 167 | `(gnus-group-mail-2-empty ((,class (:foreground "#660066")))) | 233 | `(gnus-group-mail-2-empty ((,class (:foreground "#660066")))) |
| 168 | `(gnus-group-mail-3 ((,class (:weight bold :foreground "black")))) | 234 | `(gnus-group-mail-3 ((,class ,mail-unread))) |
| 169 | `(gnus-group-mail-3-empty ((,class ,mail-read))) | 235 | `(gnus-group-mail-3-empty ((,class ,mail-read))) |
| 170 | `(gnus-group-mail-low ((,class ,cancel))) | 236 | `(gnus-group-mail-low ((,class ,cancel))) |
| 171 | `(gnus-group-mail-low-empty ((,class ,cancel))) | 237 | `(gnus-group-mail-low-empty ((,class ,cancel))) |
| @@ -173,8 +239,8 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 173 | `(gnus-group-news-1-empty ((,class (:foreground "#5050B0")))) | 239 | `(gnus-group-news-1-empty ((,class (:foreground "#5050B0")))) |
| 174 | `(gnus-group-news-2 ((,class (:weight bold :foreground "#FF0066")))) | 240 | `(gnus-group-news-2 ((,class (:weight bold :foreground "#FF0066")))) |
| 175 | `(gnus-group-news-2-empty ((,class (:foreground "#660066")))) | 241 | `(gnus-group-news-2-empty ((,class (:foreground "#660066")))) |
| 176 | `(gnus-group-news-3 ((,class (:weight bold :foreground "black")))) | 242 | `(gnus-group-news-3 ((,class ,mail-unread))) |
| 177 | `(gnus-group-news-3-empty ((,class (:foreground "#808080")))) | 243 | `(gnus-group-news-3-empty ((,class ,mail-read))) |
| 178 | `(gnus-group-news-4 ((,class (:weight bold :foreground "#FF0000")))) | 244 | `(gnus-group-news-4 ((,class (:weight bold :foreground "#FF0000")))) |
| 179 | `(gnus-group-news-4-empty ((,class (:foreground "#990000")))) | 245 | `(gnus-group-news-4-empty ((,class (:foreground "#990000")))) |
| 180 | `(gnus-group-news-5 ((,class (:weight bold :foreground "#FF0099")))) | 246 | `(gnus-group-news-5 ((,class (:weight bold :foreground "#FF0099")))) |
| @@ -194,11 +260,11 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 194 | `(gnus-signature ((,class (:slant italic :foreground "#8B8D8E")))) | 260 | `(gnus-signature ((,class (:slant italic :foreground "#8B8D8E")))) |
| 195 | `(gnus-splash ((,class (:foreground "#FF8C00")))) | 261 | `(gnus-splash ((,class (:foreground "#FF8C00")))) |
| 196 | `(gnus-summary-cancelled ((,class ,cancel))) | 262 | `(gnus-summary-cancelled ((,class ,cancel))) |
| 197 | `(gnus-summary-high-ancient ((,class (:weight normal :foreground "#808080" :background "#FFFFE6")))) | 263 | `(gnus-summary-high-ancient ((,class ,mail-unread-high))) |
| 198 | `(gnus-summary-high-read ((,class (:weight normal :foreground "#999999" :background "#FFFFE6")))) | 264 | `(gnus-summary-high-read ((,class ,mail-read-high))) |
| 199 | `(gnus-summary-high-ticked ((,class ,mail-ticked))) | 265 | `(gnus-summary-high-ticked ((,class ,mail-ticked))) |
| 200 | `(gnus-summary-high-unread ((,class (:weight bold :foreground "black" :background "#FFFFCC")))) | 266 | `(gnus-summary-high-unread ((,class ,mail-unread-high))) |
| 201 | `(gnus-summary-low-ancient ((,class (:slant italic :foreground "gray55")))) | 267 | `(gnus-summary-low-ancient ((,class (:slant italic :foreground "black")))) |
| 202 | `(gnus-summary-low-read ((,class (:slant italic :foreground "#999999" :background "#E0E0E0")))) | 268 | `(gnus-summary-low-read ((,class (:slant italic :foreground "#999999" :background "#E0E0E0")))) |
| 203 | `(gnus-summary-low-ticked ((,class ,mail-ticked))) | 269 | `(gnus-summary-low-ticked ((,class ,mail-ticked))) |
| 204 | `(gnus-summary-low-unread ((,class (:slant italic :foreground "black")))) | 270 | `(gnus-summary-low-unread ((,class (:slant italic :foreground "black")))) |
| @@ -209,82 +275,105 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 209 | `(gnus-summary-selected ((,class (:foreground "white" :background "#008CD7")))) | 275 | `(gnus-summary-selected ((,class (:foreground "white" :background "#008CD7")))) |
| 210 | `(gnus-x-face ((,class (:foreground "black" :background "white")))) | 276 | `(gnus-x-face ((,class (:foreground "black" :background "white")))) |
| 211 | 277 | ||
| 212 | ;; Message faces | 278 | ;; Message faces. |
| 213 | `(message-header-name ((,class ,mail-header-name))) | 279 | `(message-header-name ((,class ,mail-header-name))) |
| 214 | `(message-header-cc ((,class ,mail-to))) | 280 | `(message-header-cc ((,class ,mail-to))) |
| 215 | `(message-header-other ((,class ,mail-header-other))) | 281 | `(message-header-other ((,class ,mail-header-other))) |
| 216 | `(message-header-subject ((,class ,subject))) | 282 | `(message-header-subject ((,class ,subject))) |
| 217 | `(message-header-to ((,class ,mail-to))) | 283 | `(message-header-to ((,class ,mail-to))) |
| 218 | `(message-cited-text ((,class (:foreground "#5050B0")))) | 284 | `(message-cited-text ((,class (:foreground "#5050B0" :background "#F6F6F6")))) |
| 219 | `(message-separator ((,class (:family "Sans Serif" :weight normal :foreground "#BDC2C6")))) | 285 | `(message-separator ((,class (:family "Sans Serif" :weight normal :foreground "#BDC2C6")))) |
| 220 | `(message-header-newsgroups ((,class (:family "Sans Serif" :foreground "#3399CC")))) | 286 | `(message-header-newsgroups ((,class (:family "Sans Serif" :foreground "#3399CC")))) |
| 221 | `(message-header-xheader ((,class ,mail-header-other))) | 287 | `(message-header-xheader ((,class ,mail-header-other))) |
| 222 | `(message-mml ((,class (:foreground "forest green")))) | 288 | `(message-mml ((,class (:foreground "forest green")))) |
| 223 | 289 | ||
| 224 | ;; Diff | 290 | ;; Diff. |
| 225 | `(diff-added ((,class ,diff-added))) | 291 | `(diff-added ((,class ,diff-added))) |
| 226 | `(diff-changed ((,class ,diff-changed))) | 292 | `(diff-changed ((,class ,diff-changed))) |
| 227 | `(diff-context ((,class ,diff-none))) | 293 | `(diff-context ((,class ,diff-none))) |
| 228 | `(diff-file-header ((,class ,diff-header))) | 294 | `(diff-file-header ((,class ,diff-header))) |
| 229 | `(diff-file1-hunk-header ((,class (:foreground "dark magenta" :background "#EAF2F5")))) | 295 | `(diff-file1-hunk-header ((,class (:foreground "dark magenta" :background "#EAF2F5")))) |
| 230 | `(diff-file2-hunk-header ((,class (:foreground "#2B7E2A" :background "#EAF2F5")))) | 296 | `(diff-file2-hunk-header ((,class (:foreground "#2B7E2A" :background "#EAF2F5")))) |
| 231 | `(diff-function ((,class (:foreground "darkgray")))) | 297 | `(diff-function ((,class (:foreground "#CC99CC")))) |
| 232 | `(diff-header ((,class ,diff-header))) | 298 | `(diff-header ((,class ,diff-header))) |
| 233 | `(diff-hunk-header ((,class ,diff-hunk-header))) | 299 | `(diff-hunk-header ((,class ,diff-hunk-header))) |
| 234 | `(diff-index ((,class ,diff-header))) | 300 | `(diff-index ((,class ,diff-header))) |
| 235 | `(diff-indicator-added ((,class (:background "#AAFFAA")))) | 301 | `(diff-indicator-added ((,class (:foreground "#3A993A" :background "#CDFFD8")))) |
| 236 | `(diff-indicator-changed ((,class (:background "#8080FF")))) | 302 | `(diff-indicator-changed ((,class (:background "#DBEDFF")))) |
| 237 | `(diff-indicator-removed ((,class (:background "#FFBBBB")))) | 303 | `(diff-indicator-removed ((,class (:foreground "#CC3333" :background "#FFDCE0")))) |
| 304 | `(diff-refine-added ((,class ,diff-refine-added))) | ||
| 238 | `(diff-refine-change ((,class (:background "#DDDDFF")))) | 305 | `(diff-refine-change ((,class (:background "#DDDDFF")))) |
| 306 | `(diff-refine-removed ((,class ,diff-refine-removed))) | ||
| 239 | `(diff-removed ((,class ,diff-removed))) | 307 | `(diff-removed ((,class ,diff-removed))) |
| 240 | 308 | ||
| 241 | ;; SMerge | 309 | ;; SMerge. |
| 310 | `(smerge-mine ((,class ,diff-changed))) | ||
| 311 | `(smerge-other ((,class ,diff-added))) | ||
| 312 | `(smerge-base ((,class ,diff-removed))) | ||
| 313 | `(smerge-markers ((,class (:background "#FFE5CC")))) | ||
| 242 | `(smerge-refined-change ((,class (:background "#AAAAFF")))) | 314 | `(smerge-refined-change ((,class (:background "#AAAAFF")))) |
| 243 | 315 | ||
| 244 | ;; Ediff | 316 | ;; Ediff. |
| 245 | `(ediff-current-diff-A ((,class (:foreground "gray33" :background "#FFDDDD")))) | 317 | `(ediff-current-diff-A ((,class (:background "#FFDDDD")))) |
| 246 | `(ediff-current-diff-B ((,class (:foreground "gray33" :background "#DDFFDD")))) | 318 | `(ediff-current-diff-B ((,class (:background "#DDFFDD")))) |
| 247 | `(ediff-current-diff-C ((,class (:foreground "black" :background "cyan")))) | 319 | `(ediff-current-diff-C ((,class (:background "cyan")))) |
| 248 | `(ediff-even-diff-A ((,class (:foreground "black" :background "light grey")))) | 320 | `(ediff-even-diff-A ((,class (:background "light grey")))) |
| 249 | `(ediff-even-diff-B ((,class (:foreground "black" :background "light grey")))) | 321 | `(ediff-even-diff-B ((,class (:background "light grey")))) |
| 250 | `(ediff-fine-diff-A ((,class (:foreground "#A60000" :background "#FFAAAA")))) | 322 | `(ediff-fine-diff-A ((,class (:background "#FFAAAA")))) |
| 251 | `(ediff-fine-diff-B ((,class (:foreground "#008000" :background "#55FF55")))) | 323 | `(ediff-fine-diff-B ((,class (:background "#55FF55")))) |
| 252 | `(ediff-odd-diff-A ((,class (:foreground "black" :background "light grey")))) | 324 | `(ediff-odd-diff-A ((,class (:background "light grey")))) |
| 253 | `(ediff-odd-diff-B ((,class (:foreground "black" :background "light grey")))) | 325 | `(ediff-odd-diff-B ((,class (:background "light grey")))) |
| 254 | 326 | ||
| 255 | ;; Flyspell | 327 | ;; Flyspell. |
| 256 | ;; (when (version< emacs-version "24.XXX") | 328 | (if (version< emacs-version "24.4") |
| 257 | `(flyspell-duplicate ((,class (:underline "#008000" :inherit nil)))) | 329 | `(flyspell-duplicate ((,class (:underline "#F4EB80" :inherit nil)))) |
| 258 | `(flyspell-incorrect ((,class (:underline "red" :inherit nil)))) | 330 | `(flyspell-duplicate ((,class (:underline (:style wave :color "#F4EB80") :background "#FAF7CC" :inherit nil))))) |
| 259 | ;; `(flyspell-duplicate ((,class (:underline (:style wave :color "#008000") :inherit nil)))) | 331 | (if (version< emacs-version "24.4") |
| 260 | ;; `(flyspell-incorrect ((,class (:underline (:style wave :color "red") :inherit nil)))) | 332 | `(flyspell-incorrect ((,class (:underline "#FAA7A5" :inherit nil)))) |
| 261 | 333 | `(flyspell-incorrect ((,class (:underline (:style wave :color "#FAA7A5") :background "#F4D7DA":inherit nil))))) | |
| 262 | ;; ;; Semantic faces | 334 | |
| 335 | ;; ;; Semantic faces. | ||
| 263 | ;; `(semantic-decoration-on-includes ((,class (:underline ,cham-4)))) | 336 | ;; `(semantic-decoration-on-includes ((,class (:underline ,cham-4)))) |
| 264 | ;; `(semantic-decoration-on-private-members-face ((,class (:background ,alum-2)))) | 337 | ;; `(semantic-decoration-on-private-members-face ((,class (:background ,alum-2)))) |
| 265 | ;; `(semantic-decoration-on-protected-members-face ((,class (:background ,alum-2)))) | 338 | ;; `(semantic-decoration-on-protected-members-face ((,class (:background ,alum-2)))) |
| 266 | ;; `(semantic-decoration-on-unknown-includes ((,class (:background ,choc-3)))) | 339 | `(semantic-decoration-on-unknown-includes ((,class (:background "#FFF8F8")))) |
| 267 | ;; `(semantic-decoration-on-unparsed-includes ((,class (:underline ,orange-3)))) | 340 | ;; `(semantic-decoration-on-unparsed-includes ((,class (:underline ,orange-3)))) |
| 268 | ;; `(semantic-tag-boundary-face ((,class (:overline ,blue-1)))) | 341 | `(semantic-highlight-func-current-tag-face ((,class ,highlight-current-tag))) |
| 342 | `(semantic-tag-boundary-face ((,class (:overline "#777777")))) ; Method separator. | ||
| 269 | ;; `(semantic-unmatched-syntax-face ((,class (:underline ,red-1)))) | 343 | ;; `(semantic-unmatched-syntax-face ((,class (:underline ,red-1)))) |
| 270 | 344 | ||
| 271 | `(Info-title-1-face ((,class ,ol1))) | 345 | `(Info-title-1-face ((,class ,ol1))) |
| 272 | `(Info-title-2-face ((,class ,ol2))) | 346 | `(Info-title-2-face ((,class ,ol2))) |
| 273 | `(Info-title-3-face ((,class ,ol3))) | 347 | `(Info-title-3-face ((,class ,ol3))) |
| 274 | `(Info-title-4-face ((,class ,ol4))) | 348 | `(Info-title-4-face ((,class ,ol4))) |
| 275 | `(ac-completion-face ((,class (:underline nil :foreground "#C0C0C0")))) ; like Google | 349 | `(ace-jump-face-foreground ((,class (:weight bold :foreground "black" :background "#FEA500")))) |
| 276 | `(ace-jump-face-foreground ((,class (:foreground "black" :background "#FBE448")))) | 350 | `(ahs-face ((,class (:background "#E4E4FF")))) |
| 351 | `(ahs-definition-face ((,class (:background "#FFB6C6")))) | ||
| 352 | `(ahs-plugin-defalt-face ((,class (:background "#FFE4FF")))) ; Current. | ||
| 353 | `(anzu-match-1 ((,class (:foreground "black" :background "aquamarine")))) | ||
| 354 | `(anzu-match-2 ((,class (:foreground "black" :background "springgreen")))) | ||
| 355 | `(anzu-match-3 ((,class (:foreground "black" :background "red")))) | ||
| 356 | `(anzu-mode-line ((,class (:foreground "black" :background "#80FF80")))) | ||
| 357 | `(anzu-mode-line-no-match ((,class (:foreground "black" :background "#FF8080")))) | ||
| 358 | `(anzu-replace-highlight ((,class (:inherit query-replace)))) | ||
| 359 | `(anzu-replace-to ((,class (:weight bold :foreground "#BD33FD" :background "#FDBD33")))) | ||
| 277 | `(auto-dim-other-buffers-face ((,class (:background "#F7F7F7")))) | 360 | `(auto-dim-other-buffers-face ((,class (:background "#F7F7F7")))) |
| 361 | `(avy-background-face ((,class (:background "#A9A9A9")))) | ||
| 362 | `(avy-lead-face ((,class (:weight bold :foreground "black" :background "#FEA500")))) | ||
| 278 | `(bbdb-company ((,class (:slant italic :foreground "steel blue")))) | 363 | `(bbdb-company ((,class (:slant italic :foreground "steel blue")))) |
| 279 | `(bbdb-field-name ((,class (:weight bold :foreground "steel blue")))) | 364 | `(bbdb-field-name ((,class (:weight bold :foreground "steel blue")))) |
| 280 | `(bbdb-field-value ((,class (:foreground "steel blue")))) | 365 | `(bbdb-field-value ((,class (:foreground "steel blue")))) |
| 281 | `(bbdb-name ((,class (:underline t :foreground "#FF6633")))) | 366 | `(bbdb-name ((,class (:underline t :foreground "#FF6633")))) |
| 282 | `(bmkp-light-autonamed ((,class (:background "#C2DDFD")))) | 367 | `(bmkp-light-autonamed ((,class (:background "#F0F0F0")))) |
| 283 | `(bmkp-light-fringe-autonamed ((,class (:background "#90AFD5")))) | 368 | `(bmkp-light-fringe-autonamed ((,class (:foreground "#5A5A5A" :background "#D4D4D4")))) |
| 284 | `(bmkp-light-fringe-non-autonamed ((,class (:background "#D5FFD5")))) | 369 | `(bmkp-light-fringe-non-autonamed ((,class (:foreground "#FFFFCC" :background "#01FFFB")))) ; default |
| 285 | `(bmkp-light-non-autonamed ((,class (:background "#C4FFC4")))) | 370 | `(bmkp-light-non-autonamed ((,class (:background "#BFFFFE")))) |
| 286 | `(browse-kill-ring-separator-face ((,class (:weight bold :foreground "slate gray")))) | 371 | `(bmkp-no-local ((,class (:background "pink")))) |
| 372 | `(browse-kill-ring-separator-face ((,class (:foreground "red")))) | ||
| 373 | `(calendar-month-header ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) | ||
| 287 | `(calendar-today ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) | 374 | `(calendar-today ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) |
| 375 | `(calendar-weekday-header ((,class (:weight bold :foreground "#1662AF")))) | ||
| 376 | `(calendar-weekend-header ((,class (:weight bold :foreground "#4E4E4E")))) | ||
| 288 | `(cfw:face-annotation ((,class (:foreground "green" :background "red")))) | 377 | `(cfw:face-annotation ((,class (:foreground "green" :background "red")))) |
| 289 | `(cfw:face-day-title ((,class (:foreground "#C9C9C9")))) | 378 | `(cfw:face-day-title ((,class (:foreground "#C9C9C9")))) |
| 290 | `(cfw:face-default-content ((,class (:foreground "#2952A3")))) | 379 | `(cfw:face-default-content ((,class (:foreground "#2952A3")))) |
| @@ -299,12 +388,14 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 299 | `(cfw:face-sunday ((,class (:foreground "#4E4E4E" :background "white" :weight bold)))) | 388 | `(cfw:face-sunday ((,class (:foreground "#4E4E4E" :background "white" :weight bold)))) |
| 300 | `(cfw:face-title ((,class (:height 2.0 :foreground "#676767" :weight bold :inherit variable-pitch)))) | 389 | `(cfw:face-title ((,class (:height 2.0 :foreground "#676767" :weight bold :inherit variable-pitch)))) |
| 301 | `(cfw:face-today ((,class (:foreground "#4F4A3D" :background "#FFFFCC")))) | 390 | `(cfw:face-today ((,class (:foreground "#4F4A3D" :background "#FFFFCC")))) |
| 302 | `(cfw:face-today-title ((,class (:foreground "#4A95EB" :background "#FFFFCC")))) | 391 | `(cfw:face-today-title ((,class (:foreground "white" :background "#1766B1")))) |
| 303 | `(cfw:face-toolbar ((,class (:background "white")))) | 392 | `(cfw:face-toolbar ((,class (:background "white")))) |
| 304 | `(cfw:face-toolbar-button-off ((,class (:foreground "#CFCFCF" :background "white")))) | 393 | `(cfw:face-toolbar-button-off ((,class (:foreground "#CFCFCF" :background "white")))) |
| 305 | `(cfw:face-toolbar-button-on ((,class (:foreground "#5E5E5E" :background "#F6F6F6")))) | 394 | `(cfw:face-toolbar-button-on ((,class (:foreground "#5E5E5E" :background "#F6F6F6")))) |
| 306 | `(change-log-date-face ((,class (:foreground "purple")))) | 395 | `(change-log-date ((,class (:foreground "purple")))) |
| 307 | `(change-log-file ((,class (:weight bold :foreground "#4183C4")))) | 396 | `(change-log-file ((,class (:weight bold :foreground "#4183C4")))) |
| 397 | `(change-log-list ((,class (:foreground "black" :background "#75EEC7")))) | ||
| 398 | `(change-log-name ((,class (:foreground "#008000")))) | ||
| 308 | `(circe-highlight-all-nicks-face ((,class (:foreground "blue" :background "#F0F0F0")))) ; other nick names | 399 | `(circe-highlight-all-nicks-face ((,class (:foreground "blue" :background "#F0F0F0")))) ; other nick names |
| 309 | `(circe-highlight-nick-face ((,class (:foreground "#009300" :background "#F0F0F0")))) ; messages with my nick cited | 400 | `(circe-highlight-nick-face ((,class (:foreground "#009300" :background "#F0F0F0")))) ; messages with my nick cited |
| 310 | `(circe-my-message-face ((,class (:foreground "#8B8B8B" :background "#F0F0F0")))) | 401 | `(circe-my-message-face ((,class (:foreground "#8B8B8B" :background "#F0F0F0")))) |
| @@ -314,15 +405,38 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 314 | `(comint-highlight-input ((,class (:weight bold :foreground "#0000FF" :inherit nil)))) | 405 | `(comint-highlight-input ((,class (:weight bold :foreground "#0000FF" :inherit nil)))) |
| 315 | ;; `(comint-highlight-prompt ((,class (:weight bold :foreground "black" :background "gold")))) | 406 | ;; `(comint-highlight-prompt ((,class (:weight bold :foreground "black" :background "gold")))) |
| 316 | `(comint-highlight-prompt ((,class (:weight bold :foreground "#0000FF" :inherit nil)))) | 407 | `(comint-highlight-prompt ((,class (:weight bold :foreground "#0000FF" :inherit nil)))) |
| 317 | `(company-preview-common ((,class (:foreground "#C0C0C0" :background "#FFFFD7")))) ; same background as highlight-line | 408 | |
| 318 | `(company-tooltip-annotation ((,class (:foreground "#999999" :background "cornsilk")))) | 409 | ;; `(ac-selection-face ((,class ,completion-selected-candidate))) |
| 319 | `(company-tooltip-common ((,class (:weight bold :inherit company-tooltip)))) | 410 | `(ac-selection-face ((,class (:weight bold :foreground "white" :background "orange")))) ; TEMP For diff'ing AC from Comp. |
| 320 | `(company-tooltip-common-selection ((,class (:weight bold :inherit company-tooltip-selection)))) | 411 | `(ac-candidate-face ((,class ,completion-other-candidates))) |
| 412 | `(ac-completion-face ((,class ,completion-inline))) | ||
| 413 | `(ac-candidate-mouse-face ((,class (:inherit highlight)))) | ||
| 414 | `(popup-scroll-bar-background-face ((,class (:background "#EBF4FE")))) | ||
| 415 | `(popup-scroll-bar-foreground-face ((,class (:background "#D1DAE4")))) ; Scrollbar (visible). | ||
| 416 | |||
| 417 | `(company-tooltip-common-selection ((,class (:weight normal :foreground "#F9ECCC" :inherit company-tooltip-selection)))) ; Prefix + common part in tooltip (for selection). | ||
| 418 | `(company-tooltip-selection ((,class ,completion-selected-candidate))) ; Suffix in tooltip (for selection). | ||
| 419 | `(company-tooltip-annotation-selection ((,class (:weight normal :foreground "#F9ECCC")))) ; Annotation (for selection). | ||
| 420 | |||
| 421 | `(company-tooltip-common ((,class (:weight normal :foreground "#B000B0" :inherit company-tooltip)))) ; Prefix + common part in tooltip. | ||
| 422 | `(company-tooltip ((,class ,completion-other-candidates))) ; Suffix in tooltip. | ||
| 423 | `(company-tooltip-annotation ((,class (:weight normal :foreground "#2415FF")))) ; Annotation. | ||
| 424 | |||
| 425 | `(company-preview-common ((,class ,completion-inline))) | ||
| 426 | |||
| 427 | `(company-scrollbar-bg ((,class (:background "#EBF4FE")))) | ||
| 428 | `(company-scrollbar-fg ((,class (:background "#D1DAE4")))) ; Scrollbar (visible). | ||
| 429 | |||
| 321 | `(compare-windows ((,class (:background "#FFFF00")))) | 430 | `(compare-windows ((,class (:background "#FFFF00")))) |
| 322 | `(compilation-error ((,class (:weight bold :foreground "red")))) | 431 | ;; `(completions-common-part ((,class (:foreground "red" :weight bold)))) |
| 323 | `(compilation-info ((,class (:weight bold :foreground "#2A489E")))) ; used for grep | 432 | ;; `(completions-first-difference ((,class (:foreground "green" :weight bold)))) |
| 324 | `(compilation-line-number ((,class (:weight bold :foreground "#A535AE")))) | 433 | `(compilation-error ((,class (:weight bold :foreground "red")))) ; Used for grep error messages. |
| 434 | `(compilation-info ((,class (:weight bold :foreground "#6784d7")))) | ||
| 435 | `(compilation-line-number ((,class ,grep-line-number))) | ||
| 325 | `(compilation-warning ((,class (:weight bold :foreground "orange")))) | 436 | `(compilation-warning ((,class (:weight bold :foreground "orange")))) |
| 437 | `(compilation-mode-line-exit ((,class (:weight bold :foreground "green")))) ; :exit[matched] | ||
| 438 | `(compilation-mode-line-fail ((,class (:weight bold :foreground "violet")))) ; :exit[no match] | ||
| 439 | `(compilation-mode-line-run ((,class (:weight bold :foreground "orange")))) ; :run | ||
| 326 | `(css-property ((,class (:foreground "#00AA00")))) | 440 | `(css-property ((,class (:foreground "#00AA00")))) |
| 327 | `(css-selector ((,class (:weight bold :foreground "blue")))) | 441 | `(css-selector ((,class (:weight bold :foreground "blue")))) |
| 328 | `(custom-button ((,class (:box (:line-width 2 :style released-button) :foreground "black" :background "lightgrey")))) | 442 | `(custom-button ((,class (:box (:line-width 2 :style released-button) :foreground "black" :background "lightgrey")))) |
| @@ -348,11 +462,14 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 348 | `(custom-variable-button ((,class (:weight bold :underline t)))) | 462 | `(custom-variable-button ((,class (:weight bold :underline t)))) |
| 349 | `(custom-variable-tag ((,class (:family "Sans Serif" :height 1.2 :weight bold :foreground "blue1")))) | 463 | `(custom-variable-tag ((,class (:family "Sans Serif" :height 1.2 :weight bold :foreground "blue1")))) |
| 350 | `(custom-visibility ((,class ,link))) | 464 | `(custom-visibility ((,class ,link))) |
| 351 | `(diff-hl-change ((,class (:foreground "blue3" :inherit diff-changed)))) | 465 | `(diff-hl-change ((,class (:foreground "blue3" :background "#DBEDFF")))) |
| 352 | `(diff-hl-delete ((,class (:foreground "red3" :inherit diff-removed)))) | 466 | `(diff-hl-delete ((,class (:foreground "red3" :background "#FFDCE0")))) |
| 353 | `(diff-hl-dired-change ((,class (:background "#FFA335" :foreground "black" :weight bold)))) | 467 | `(diff-hl-dired-change ((,class (:weight bold :foreground "black" :background "#FFA335")))) |
| 468 | `(diff-hl-dired-delete ((,class (:weight bold :foreground "#D73915")))) | ||
| 469 | `(diff-hl-dired-ignored ((,class (:weight bold :foreground "white" :background "#C0BBAB")))) | ||
| 470 | `(diff-hl-dired-insert ((,class (:weight bold :foreground "#B9B9BA")))) | ||
| 354 | `(diff-hl-dired-unknown ((,class (:foreground "white" :background "#3F3BB4")))) | 471 | `(diff-hl-dired-unknown ((,class (:foreground "white" :background "#3F3BB4")))) |
| 355 | `(diff-hl-insert ((,class (:foreground "green4" :inherit diff-added)))) | 472 | `(diff-hl-insert ((,class (:foreground "green4" :background "#CDFFD8")))) |
| 356 | `(diff-hl-unknown ((,class (:foreground "white" :background "#3F3BB4")))) | 473 | `(diff-hl-unknown ((,class (:foreground "white" :background "#3F3BB4")))) |
| 357 | `(diary-face ((,class (:foreground "#87C9FC")))) | 474 | `(diary-face ((,class (:foreground "#87C9FC")))) |
| 358 | `(dircolors-face-asm ((,class (:foreground "black")))) | 475 | `(dircolors-face-asm ((,class (:foreground "black")))) |
| @@ -385,17 +502,36 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 385 | `(diredp-compressed-file-suffix ((,class (:foreground "red")))) | 502 | `(diredp-compressed-file-suffix ((,class (:foreground "red")))) |
| 386 | `(diredp-date-time ((,class (:foreground "purple")))) | 503 | `(diredp-date-time ((,class (:foreground "purple")))) |
| 387 | `(diredp-dir-heading ((,class ,directory))) | 504 | `(diredp-dir-heading ((,class ,directory))) |
| 505 | `(diredp-dir-name ((,class ,directory))) | ||
| 388 | `(diredp-dir-priv ((,class ,directory))) | 506 | `(diredp-dir-priv ((,class ,directory))) |
| 389 | `(diredp-exec-priv ((,class (:background "#03C03C")))) | 507 | `(diredp-exec-priv ((,class (:background "#03C03C")))) |
| 390 | `(diredp-executable-tag ((,class (:foreground "ForestGreen" :background "white")))) | 508 | `(diredp-executable-tag ((,class (:foreground "ForestGreen" :background "white")))) |
| 391 | `(diredp-file-name ((,class (:foreground "black")))) | 509 | `(diredp-file-name ((,class ,file))) |
| 392 | `(diredp-file-suffix ((,class (:foreground "#C0C0C0")))) | 510 | `(diredp-file-suffix ((,class (:foreground "#C0C0C0")))) |
| 393 | `(diredp-flag-mark-line ((,class ,marked-line))) | 511 | `(diredp-flag-mark-line ((,class ,marked-line))) |
| 394 | `(diredp-ignored-file-name ((,class ,shadow))) | 512 | `(diredp-ignored-file-name ((,class ,shadow))) |
| 395 | `(diredp-read-priv ((,class (:background "#0A99FF")))) | 513 | `(diredp-read-priv ((,class (:background "#0A99FF")))) |
| 396 | `(diredp-write-priv ((,class (:foreground "white" :background "#FF4040")))) | 514 | `(diredp-write-priv ((,class (:foreground "white" :background "#FF4040")))) |
| 515 | `(eldoc-highlight-function-argument ((,class (:weight bold :foreground "red" :background "#FFE4FF")))) | ||
| 516 | `(elfeed-search-filter-face ((,class (:foreground "gray")))) | ||
| 517 | ;; `(eww-form-checkbox ((,class ()))) | ||
| 518 | ;; `(eww-form-select ((,class ()))) | ||
| 519 | ;; `(eww-form-submit ((,class ()))) | ||
| 520 | `(eww-form-text ((,class (:weight bold :foreground "#40586F" :background "#A7CDF1")))) | ||
| 521 | ;; `(eww-form-textarea ((,class ()))) | ||
| 397 | `(file-name-shadow ((,class ,shadow))) | 522 | `(file-name-shadow ((,class ,shadow))) |
| 523 | `(flycheck-error ((,class (:underline (:color "#FE251E" :style wave) :weight bold :background "#FFE1E1")))) | ||
| 524 | `(flycheck-error-list-line-number ((,class (:foreground "#A535AE")))) | ||
| 525 | `(flycheck-fringe-error ((,class (:foreground "#FE251E")))) | ||
| 526 | `(flycheck-fringe-info ((,class (:foreground "#158A15")))) | ||
| 527 | `(flycheck-fringe-warning ((,class (:foreground "#F4A939")))) | ||
| 528 | `(flycheck-info ((,class (:underline (:color "#158A15" :style wave) :weight bold)))) | ||
| 529 | `(flycheck-warning ((,class (:underline (:color "#F4A939" :style wave) :weight bold :background "#FFFFBE")))) | ||
| 398 | `(font-latex-bold-face ((,class (:weight bold :foreground "black")))) | 530 | `(font-latex-bold-face ((,class (:weight bold :foreground "black")))) |
| 531 | `(fancy-narrow-blocked-face ((,class (:foreground "#9998A4")))) | ||
| 532 | `(flycheck-color-mode-line-error-face ((, class (:background "#CF5B56")))) | ||
| 533 | `(flycheck-color-mode-line-warning-face ((, class (:background "#EBC700")))) | ||
| 534 | `(flycheck-color-mode-line-info-face ((, class (:background "yellow")))) | ||
| 399 | `(font-latex-italic-face ((,class (:slant italic :foreground "#1A1A1A")))) | 535 | `(font-latex-italic-face ((,class (:slant italic :foreground "#1A1A1A")))) |
| 400 | `(font-latex-math-face ((,class (:foreground "blue")))) | 536 | `(font-latex-math-face ((,class (:foreground "blue")))) |
| 401 | `(font-latex-sectioning-1-face ((,class (:family "Sans Serif" :height 2.7 :weight bold :foreground "cornflower blue")))) | 537 | `(font-latex-sectioning-1-face ((,class (:family "Sans Serif" :height 2.7 :weight bold :foreground "cornflower blue")))) |
| @@ -408,36 +544,65 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 408 | `(font-latex-verbatim-face ((,class (:foreground "#000088" :background "#FFFFE0" :inherit nil)))) | 544 | `(font-latex-verbatim-face ((,class (:foreground "#000088" :background "#FFFFE0" :inherit nil)))) |
| 409 | `(git-commit-summary-face ((,class (:foreground "#000000")))) | 545 | `(git-commit-summary-face ((,class (:foreground "#000000")))) |
| 410 | `(git-commit-comment-face ((,class (:slant italic :foreground "#696969")))) | 546 | `(git-commit-comment-face ((,class (:slant italic :foreground "#696969")))) |
| 547 | `(git-timemachine-commit ((,class ,diff-removed))) | ||
| 548 | `(git-timemachine-minibuffer-author-face ((,class ,diff-added))) | ||
| 549 | `(git-timemachine-minibuffer-detail-face ((,class ,diff-header))) | ||
| 550 | `(google-translate-text-face ((,class (:foreground "#777777" :background "#F5F5F5")))) | ||
| 551 | `(google-translate-phonetic-face ((,class (:inherit shadow)))) | ||
| 552 | `(google-translate-translation-face ((,class (:weight normal :foreground "#3079ED" :background "#E3EAF2")))) | ||
| 553 | `(google-translate-suggestion-label-face ((,class (:foreground "red")))) | ||
| 554 | `(google-translate-suggestion-face ((,class (:slant italic :underline t)))) | ||
| 555 | `(google-translate-listen-button-face ((,class (:height 0.8)))) | ||
| 411 | `(helm-action ((,class (:foreground "black")))) | 556 | `(helm-action ((,class (:foreground "black")))) |
| 557 | `(helm-bookmark-file ((,class ,file))) | ||
| 412 | `(helm-bookmarks-su-face ((,class (:foreground "red")))) | 558 | `(helm-bookmarks-su-face ((,class (:foreground "red")))) |
| 559 | `(helm-buffer-directory ((,class ,directory))) | ||
| 560 | ;; `(helm-non-file-buffer ((,class (:slant italic :foreground "blue")))) | ||
| 561 | ;; `(helm-buffer-file ((,class (:foreground "#333333")))) | ||
| 562 | `(helm-buffer-modified ((,class (:slant italic :foreground "#BA36A5")))) | ||
| 413 | `(helm-buffer-process ((,class (:foreground "#008200")))) | 563 | `(helm-buffer-process ((,class (:foreground "#008200")))) |
| 414 | `(helm-candidate-number ((,class (:foreground "black" :background "#FFFF66")))) | 564 | `(helm-candidate-number ((,class (:foreground "black" :background "#FFFF66")))) |
| 415 | `(helm-dir-heading ((,class (:foreground "blue" :background "pink")))) | 565 | `(helm-dir-heading ((,class (:foreground "blue" :background "pink")))) |
| 416 | `(helm-dir-priv ((,class (:foreground "dark red" :background "light grey")))) | 566 | `(helm-dir-priv ((,class (:foreground "dark red" :background "light grey")))) |
| 417 | `(helm-ff-directory ((,class ,directory))) | 567 | `(helm-ff-directory ((,class ,directory))) |
| 568 | `(helm-ff-dotted-directory ((,class ,directory))) | ||
| 418 | `(helm-ff-executable ((,class (:foreground "green3" :background "white")))) | 569 | `(helm-ff-executable ((,class (:foreground "green3" :background "white")))) |
| 419 | `(helm-ff-file ((,class (:foreground "black")))) | 570 | `(helm-ff-file ((,class (:foreground "black")))) |
| 420 | `(helm-ff-invalid-symlink ((,class (:foreground "yellow" :background "red")))) | 571 | `(helm-ff-invalid-symlink ((,class (:foreground "yellow" :background "red")))) |
| 421 | `(helm-ff-symlink ((,class ,symlink))) | 572 | `(helm-ff-symlink ((,class ,symlink))) |
| 422 | `(helm-file-name ((,class (:foreground "blue")))) | 573 | `(helm-file-name ((,class (:foreground "blue")))) |
| 423 | `(helm-gentoo-match-face ((,class (:foreground "red")))) | 574 | `(helm-gentoo-match-face ((,class (:foreground "red")))) |
| 575 | `(helm-grep-file ((,class ,grep-file-name))) | ||
| 576 | `(helm-grep-lineno ((,class ,grep-line-number))) | ||
| 424 | `(helm-grep-match ((,class ,match))) | 577 | `(helm-grep-match ((,class ,match))) |
| 425 | `(helm-grep-running ((,class (:weight bold :foreground "white")))) | 578 | `(helm-grep-running ((,class (:weight bold :foreground "white")))) |
| 426 | `(helm-grep-lineno ((,class ,shadow))) | ||
| 427 | `(helm-isearch-match ((,class (:background "#CCFFCC")))) | 579 | `(helm-isearch-match ((,class (:background "#CCFFCC")))) |
| 580 | `(helm-lisp-show-completion ((,class ,volatile-highlight-supersize))) ; See `helm-dabbrev'. | ||
| 581 | ;; `(helm-ls-git-added-copied-face ((,class (:foreground "")))) | ||
| 582 | ;; `(helm-ls-git-added-modified-face ((,class (:foreground "")))) | ||
| 583 | ;; `(helm-ls-git-conflict-face ((,class (:foreground "")))) | ||
| 584 | ;; `(helm-ls-git-deleted-and-staged-face ((,class (:foreground "")))) | ||
| 585 | ;; `(helm-ls-git-deleted-not-staged-face ((,class (:foreground "")))) | ||
| 586 | ;; `(helm-ls-git-modified-and-staged-face ((,class (:foreground "")))) | ||
| 587 | `(helm-ls-git-modified-not-staged-face ((,class (:foreground "#BA36A5")))) | ||
| 588 | ;; `(helm-ls-git-renamed-modified-face ((,class (:foreground "")))) | ||
| 589 | ;; `(helm-ls-git-untracked-face ((,class (:foreground "")))) | ||
| 428 | `(helm-match ((,class ,match))) | 590 | `(helm-match ((,class ,match))) |
| 429 | `(helm-moccur-buffer ((,class (:foreground "#0066CC")))) | 591 | `(helm-moccur-buffer ((,class (:foreground "#0066CC")))) |
| 430 | `(helm-selection ((,class ,volatile-highlight))) | 592 | `(helm-selection ((,class (:background "#3875D6" :foreground "white")))) |
| 431 | `(helm-selection-line ((,class ,volatile-highlight))) | 593 | `(helm-selection-line ((,class ,highlight-gray))) ; ??? |
| 432 | `(helm-source-header ((,class (:family "Sans Serif" :height 1.3 :weight bold :foreground "white" :background "#2F69BF")))) | 594 | `(helm-separator ((,class (:foreground "red")))) |
| 433 | `(helm-swoop-target-line-face ((,class ,volatile-highlight))) | 595 | `(helm-source-header ((,class (:weight bold :box (:line-width 1 :color "#C7C7C7") :background "#DEDEDE" :foreground "black")))) |
| 434 | `(helm-swoop-target-line-block-face ((,class (:background "#CCCC00" :foreground "#222222")))) | 596 | `(helm-swoop-target-line-block-face ((,class (:background "#CCCC00" :foreground "#222222")))) |
| 597 | `(helm-swoop-target-line-face ((,class (:background "#CCCCFF")))) | ||
| 435 | `(helm-swoop-target-word-face ((,class (:weight bold :foreground nil :background "#FDBD33")))) | 598 | `(helm-swoop-target-word-face ((,class (:weight bold :foreground nil :background "#FDBD33")))) |
| 436 | `(helm-visible-mark ((,class ,marked-line))) | 599 | `(helm-visible-mark ((,class ,marked-line))) |
| 437 | `(helm-w3m-bookmarks-face ((,class (:underline t :foreground "cyan1")))) | 600 | `(helm-w3m-bookmarks-face ((,class (:underline t :foreground "cyan1")))) |
| 601 | `(highlight-changes ((,class (:foreground nil)))) ;; blue "#2E08B5" | ||
| 602 | `(highlight-changes-delete ((,class (:strike-through nil :foreground nil)))) ;; red "#B5082E" | ||
| 438 | `(highlight-symbol-face ((,class (:background "#FFFFA0")))) | 603 | `(highlight-symbol-face ((,class (:background "#FFFFA0")))) |
| 439 | `(hl-line ((,class ,highlight-line))) | 604 | `(hl-line ((,class ,highlight-yellow))) ; Highlight current line. |
| 440 | `(hl-tags-face ((,class (:background "#FEFCAE")))) | 605 | `(hl-tags-face ((,class ,highlight-current-tag))) ; ~ Pair highlighting (matching tags). |
| 441 | `(holiday-face ((,class (:foreground "#777777" :background "#E4EBFE")))) | 606 | `(holiday-face ((,class (:foreground "#777777" :background "#E4EBFE")))) |
| 442 | `(html-helper-bold-face ((,class (:weight bold :foreground "black")))) | 607 | `(html-helper-bold-face ((,class (:weight bold :foreground "black")))) |
| 443 | `(html-helper-italic-face ((,class (:slant italic :foreground "black")))) | 608 | `(html-helper-italic-face ((,class (:slant italic :foreground "black")))) |
| @@ -448,9 +613,11 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 448 | `(ilog-echo-face ((,class (:height 2.0 :foreground "#006FE0")))) | 613 | `(ilog-echo-face ((,class (:height 2.0 :foreground "#006FE0")))) |
| 449 | `(ilog-load-face ((,class (:foreground "#BA36A5")))) | 614 | `(ilog-load-face ((,class (:foreground "#BA36A5")))) |
| 450 | `(ilog-message-face ((,class (:foreground "#808080")))) | 615 | `(ilog-message-face ((,class (:foreground "#808080")))) |
| 616 | `(indent-guide-face ((,class (:foreground "#D3D3D3")))) | ||
| 451 | `(info-file ((,class (:family "Sans Serif" :height 1.8 :weight bold :box (:line-width 1 :color "#0000CC") :foreground "cornflower blue" :background "LightSteelBlue1")))) | 617 | `(info-file ((,class (:family "Sans Serif" :height 1.8 :weight bold :box (:line-width 1 :color "#0000CC") :foreground "cornflower blue" :background "LightSteelBlue1")))) |
| 452 | `(info-header-node ((,class (:underline t :foreground "orange")))) ; nodes in header | 618 | `(info-header-node ((,class (:underline t :foreground "orange")))) ; nodes in header |
| 453 | `(info-header-xref ((,class (:underline t :foreground "dodger blue")))) ; cross references in header | 619 | `(info-header-xref ((,class (:underline t :foreground "dodger blue")))) ; cross references in header |
| 620 | `(info-index-match ((,class (:weight bold :foreground nil :background "#FDBD33")))) ; when using `i' | ||
| 454 | `(info-menu-header ((,class ,ol2))) ; menu titles (headers) -- major topics | 621 | `(info-menu-header ((,class ,ol2))) ; menu titles (headers) -- major topics |
| 455 | `(info-menu-star ((,class (:foreground "black")))) ; every 3rd menu item | 622 | `(info-menu-star ((,class (:foreground "black")))) ; every 3rd menu item |
| 456 | `(info-node ((,class (:underline t :foreground "blue")))) ; node names | 623 | `(info-node ((,class (:underline t :foreground "blue")))) ; node names |
| @@ -459,16 +626,49 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 459 | `(info-title-1 ((,class ,ol1))) | 626 | `(info-title-1 ((,class ,ol1))) |
| 460 | `(info-xref ((,class (:underline t :foreground "#006DAF")))) ; unvisited cross-references | 627 | `(info-xref ((,class (:underline t :foreground "#006DAF")))) ; unvisited cross-references |
| 461 | `(info-xref-visited ((,class (:underline t :foreground "magenta4")))) ; previously visited cross-references | 628 | `(info-xref-visited ((,class (:underline t :foreground "magenta4")))) ; previously visited cross-references |
| 629 | ;; js2-highlight-vars-face (~ auto-highlight-symbol) | ||
| 630 | `(js2-error ((,class (:box (:line-width 1 :color "#FF3737") :background "#FFC8C8")))) ; DONE. | ||
| 631 | `(js2-external-variable ((,class (:foreground "#FF0000" :background "#FFF8F8")))) ; DONE. | ||
| 632 | `(js2-function-param ((,class ,function-param))) | ||
| 633 | `(js2-instance-member ((,class (:foreground "DarkOrchid")))) | ||
| 634 | `(js2-jsdoc-html-tag-delimiter ((,class (:foreground "#D0372D")))) | ||
| 635 | `(js2-jsdoc-html-tag-name ((,class (:foreground "#D0372D")))) | ||
| 636 | `(js2-jsdoc-tag ((,class (:weight normal :foreground "#6434A3")))) | ||
| 637 | `(js2-jsdoc-type ((,class (:foreground "SteelBlue")))) | ||
| 638 | `(js2-jsdoc-value ((,class (:weight normal :foreground "#BA36A5")))) ; #800080 | ||
| 639 | `(js2-magic-paren ((,class (:underline t)))) | ||
| 640 | `(js2-private-function-call ((,class (:foreground "goldenrod")))) | ||
| 641 | `(js2-private-member ((,class (:foreground "PeachPuff3")))) | ||
| 642 | `(js2-warning ((,class (:underline "orange")))) | ||
| 643 | |||
| 644 | ;; Org non-standard faces. | ||
| 645 | `(leuven-org-deadline-overdue ((,class (:foreground "#F22659")))) | ||
| 646 | `(leuven-org-deadline-today ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) | ||
| 647 | `(leuven-org-deadline-tomorrow ((,class (:foreground "#40A80B")))) | ||
| 648 | `(leuven-org-deadline-future ((,class (:foreground "#40A80B")))) | ||
| 649 | `(leuven-gnus-unseen ((,class (:weight bold :foreground "#FC7202")))) | ||
| 650 | `(leuven-gnus-date ((,class (:foreground "#FF80BF")))) | ||
| 651 | `(leuven-gnus-size ((,class (:foreground "#8FBF60")))) | ||
| 652 | `(leuven-todo-items-face ((,class (:weight bold :foreground "#FF3125" :background "#FFFF88")))) | ||
| 653 | |||
| 462 | `(light-symbol-face ((,class (:background "#FFFFA0")))) | 654 | `(light-symbol-face ((,class (:background "#FFFFA0")))) |
| 463 | `(linum ((,class (:inherit (default shadow) :foreground "#9A9A9A" :background "#EDEDED")))) | 655 | `(linum ((,class (:foreground "#9A9A9A" :background "#EDEDED")))) |
| 464 | `(log-view-file ((,class (:foreground "#0000CC" :background "#EAF2F5")))) | 656 | `(log-view-file ((,class (:foreground "#0000CC" :background "#EAF2F5")))) |
| 657 | `(log-view-message ((,class (:foreground "black" :background "#EDEA74")))) | ||
| 658 | `(lsp-ui-doc-background ((,class (:background "#F6FECD")))) | ||
| 465 | `(lui-button-face ((,class ,link))) | 659 | `(lui-button-face ((,class ,link))) |
| 466 | `(lui-highlight-face ((,class (:box '(:line-width 1 :color "#CC0000") :foreground "#CC0000" :background "#FFFF88")))) ; my nickname | 660 | `(lui-highlight-face ((,class (:box '(:line-width 1 :color "#CC0000") :foreground "#CC0000" :background "#FFFF88")))) ; my nickname |
| 467 | `(lui-time-stamp-face ((,class (:foreground "purple")))) | 661 | `(lui-time-stamp-face ((,class (:foreground "purple")))) |
| 662 | `(magit-blame-header ((,class (:inherit magit-diff-file-header)))) | ||
| 663 | `(magit-blame-heading ((,class (:overline "#A7A7A7" :foreground "red" :background "#E6E6E6")))) | ||
| 664 | `(magit-blame-hash ((,class (:overline "#A7A7A7" :foreground "red" :background "#E6E6E6")))) | ||
| 665 | `(magit-blame-name ((,class (:overline "#A7A7A7" :foreground "#036A07" :background "#E6E6E6")))) | ||
| 666 | `(magit-blame-date ((,class (:overline "#A7A7A7" :foreground "blue" :background "#E6E6E6")))) | ||
| 667 | `(magit-blame-summary ((,class (:overline "#A7A7A7" :weight bold :foreground "#707070" :background "#E6E6E6")))) | ||
| 468 | `(magit-branch ((,class ,vc-branch))) | 668 | `(magit-branch ((,class ,vc-branch))) |
| 469 | `(magit-diff-add ((,class ,diff-added))) | 669 | `(magit-diff-add ((,class ,diff-added))) |
| 470 | `(magit-diff-del ((,class ,diff-removed))) | 670 | `(magit-diff-del ((,class ,diff-removed))) |
| 471 | `(magit-diff-file-header ((,class (:family "Sans Serif" :height 1.1 :weight bold :foreground "#4183C4")))) | 671 | `(magit-diff-file-header ((,class (:height 1.1 :weight bold :foreground "#4183C4")))) |
| 472 | `(magit-diff-hunk-header ((,class ,diff-hunk-header))) | 672 | `(magit-diff-hunk-header ((,class ,diff-hunk-header))) |
| 473 | `(magit-diff-none ((,class ,diff-none))) | 673 | `(magit-diff-none ((,class ,diff-none))) |
| 474 | `(magit-header ((,class (:foreground "white" :background "#FF4040")))) | 674 | `(magit-header ((,class (:foreground "white" :background "#FF4040")))) |
| @@ -476,48 +676,82 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 476 | `(magit-item-mark ((,class ,marked-line))) | 676 | `(magit-item-mark ((,class ,marked-line))) |
| 477 | `(magit-log-head-label ((,class (:box (:line-width 1 :color "blue" :style nil))))) | 677 | `(magit-log-head-label ((,class (:box (:line-width 1 :color "blue" :style nil))))) |
| 478 | `(magit-log-tag-label ((,class (:box (:line-width 1 :color "#00CC00" :style nil))))) | 678 | `(magit-log-tag-label ((,class (:box (:line-width 1 :color "#00CC00" :style nil))))) |
| 679 | `(magit-section-highlight ((,class (:background "#F6FECD")))) | ||
| 479 | `(magit-section-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "cornflower blue" :inherit nil)))) | 680 | `(magit-section-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "cornflower blue" :inherit nil)))) |
| 480 | `(makefile-space-face ((,class (:background "hot pink")))) | 681 | `(makefile-space-face ((,class (:background "hot pink")))) |
| 481 | `(makefile-targets ((,class (:weight bold :foreground "blue")))) | 682 | `(makefile-targets ((,class (:weight bold :foreground "blue")))) |
| 482 | `(match ((,class ,match))) | 683 | ;; `(markdown-blockquote-face ((,class ()))) |
| 684 | `(markdown-bold-face ((,class (:inherit bold)))) | ||
| 685 | ;; `(markdown-comment-face ((,class ()))) | ||
| 686 | ;; `(markdown-footnote-face ((,class ()))) | ||
| 687 | ;; `(markdown-header-delimiter-face ((,class ()))) | ||
| 688 | ;; `(markdown-header-face ((,class ()))) | ||
| 689 | `(markdown-header-face-1 ((,class ,ol1))) | ||
| 690 | `(markdown-header-face-2 ((,class ,ol2))) | ||
| 691 | `(markdown-header-face-3 ((,class ,ol3))) | ||
| 692 | `(markdown-header-face-4 ((,class ,ol4))) | ||
| 693 | `(markdown-header-face-5 ((,class ,ol5))) | ||
| 694 | `(markdown-header-face-6 ((,class ,ol6))) | ||
| 695 | ;; `(markdown-header-rule-face ((,class ()))) | ||
| 696 | `(markdown-inline-code-face ((,class ,code-inline))) | ||
| 697 | `(markdown-italic-face ((,class (:inherit italic)))) | ||
| 698 | `(markdown-language-keyword-face ((,class (:inherit org-block-begin-line)))) | ||
| 699 | ;; `(markdown-line-break-face ((,class ()))) | ||
| 700 | `(markdown-link-face ((,class ,link-no-underline))) | ||
| 701 | ;; `(markdown-link-title-face ((,class ()))) | ||
| 702 | ;; `(markdown-list-face ((,class ()))) | ||
| 703 | ;; `(markdown-math-face ((,class ()))) | ||
| 704 | ;; `(markdown-metadata-key-face ((,class ()))) | ||
| 705 | ;; `(markdown-metadata-value-face ((,class ()))) | ||
| 706 | ;; `(markdown-missing-link-face ((,class ()))) | ||
| 707 | `(markdown-pre-face ((,class (:inherit org-block-background)))) | ||
| 708 | ;; `(markdown-reference-face ((,class ()))) | ||
| 709 | ;; `(markdown-strike-through-face ((,class ()))) | ||
| 710 | `(markdown-url-face ((,class ,link))) | ||
| 711 | `(match ((,class ,match))) ; Used for grep matches. | ||
| 712 | `(mc/cursor-bar-face ((,class (:height 1.0 :foreground "#1664C4" :background "#1664C4")))) | ||
| 713 | `(mc/cursor-face ((,class (:inverse-video t)))) | ||
| 714 | `(mc/region-face ((,class (:inherit region)))) | ||
| 483 | `(mm-uu-extract ((,class ,code-block))) | 715 | `(mm-uu-extract ((,class ,code-block))) |
| 484 | `(moccur-current-line-face ((,class (:foreground "black" :background "#FFFFCC")))) | 716 | `(moccur-current-line-face ((,class (:foreground "black" :background "#FFFFCC")))) |
| 485 | `(moccur-face ((,class (:foreground "black" :background "#FFFF99")))) | 717 | `(moccur-face ((,class (:foreground "black" :background "#FFFF99")))) |
| 486 | `(next-error ((,class ,volatile-highlight))) | 718 | `(next-error ((,class ,volatile-highlight-supersize))) |
| 487 | `(nobreak-space ((,class (:background "#CCE8F6")))) | 719 | `(nobreak-space ((,class (:background "#CCE8F6")))) |
| 488 | `(nxml-attribute-local-name-face ((,class (:foreground "magenta")))) | 720 | `(nxml-attribute-local-name-face ((,class ,xml-attribute))) |
| 489 | `(nxml-attribute-value-delimiter-face ((,class (:foreground "green4")))) | 721 | `(nxml-attribute-value-delimiter-face ((,class (:foreground "green4")))) |
| 490 | `(nxml-attribute-value-face ((,class (:foreground "green4")))) | 722 | `(nxml-attribute-value-face ((,class (:foreground "green4")))) |
| 491 | `(nxml-comment-content-face ((,class (:slant italic :foreground "red")))) | 723 | `(nxml-comment-content-face ((,class (:slant italic :foreground "red")))) |
| 492 | `(nxml-comment-delimiter-face ((,class (:foreground "red")))) | 724 | `(nxml-comment-delimiter-face ((,class (:foreground "red")))) |
| 493 | `(nxml-element-local-name ((,class (:box (:line-width 1 :color "#999999") :foreground "#000088" :background "#DEDEDE")))) | 725 | `(nxml-element-local-name ((,class ,xml-tag))) |
| 494 | `(nxml-element-local-name-face ((,class (:foreground "blue")))) | 726 | `(nxml-element-local-name-face ((,class (:foreground "blue")))) |
| 495 | `(nxml-processing-instruction-target-face ((,class (:foreground "purple1")))) | 727 | `(nxml-processing-instruction-target-face ((,class (:foreground "purple1")))) |
| 496 | `(nxml-tag-delimiter-face ((,class (:foreground "blue")))) | 728 | `(nxml-tag-delimiter-face ((,class (:foreground "blue")))) |
| 497 | `(nxml-tag-slash-face ((,class (:foreground "blue")))) | 729 | `(nxml-tag-slash-face ((,class (:foreground "blue")))) |
| 498 | `(org-agenda-block-count ((,class (:weight bold :foreground "#A5A5A5")))) | 730 | `(org-agenda-block-count ((,class (:weight bold :foreground "#A5A5A5")))) |
| 499 | `(org-agenda-calendar-event ((,class (:weight bold :foreground "#3774CC" :background "#A8C5EF")))) | 731 | `(org-agenda-calendar-event ((,class (:weight bold :foreground "#3774CC" :background "#E4EBFE")))) |
| 500 | `(org-agenda-calendar-sexp ((,class (:foreground "#777777" :background "#E4EBFE")))) | 732 | `(org-agenda-calendar-sexp ((,class (:foreground "#327ACD" :background "#F3F7FC")))) |
| 501 | `(org-agenda-clocking ((,class (:foreground "black" :background "#EEC900")))) | 733 | `(org-agenda-clocking ((,class (:foreground "black" :background "#EEC900")))) |
| 502 | `(org-agenda-column-dateline ((,class ,column))) | 734 | `(org-agenda-column-dateline ((,class ,column))) |
| 503 | `(org-agenda-current-time ((,class (:underline t :foreground "#1662AF")))) | 735 | `(org-agenda-current-time ((,class (:underline t :foreground "#1662AF")))) |
| 504 | `(org-agenda-date ((,class (:height 1.6 :weight bold :foreground "#1662AF")))) | 736 | `(org-agenda-date ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#1662AF")))) |
| 505 | `(org-agenda-date-today ((,class (:height 1.6 :weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) | 737 | `(org-agenda-date-today ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) |
| 506 | `(org-agenda-date-weekend ((,class (:height 1.6 :weight bold :foreground "#4E4E4E")))) | 738 | `(org-agenda-date-weekend ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#4E4E4E")))) |
| 507 | `(org-agenda-diary ((,class (:weight bold :foreground "green4" :background "light blue")))) | 739 | `(org-agenda-diary ((,class (:weight bold :foreground "green4" :background "light blue")))) |
| 508 | `(org-agenda-dimmed-todo-face ((,class (:foreground "gold2")))) | 740 | `(org-agenda-dimmed-todo-face ((,class (:foreground "gold2")))) |
| 509 | `(org-agenda-done ((,class (:foreground "#555555")))) | 741 | `(org-agenda-done ((,class (:foreground "#555555")))) |
| 510 | `(org-agenda-filter-category ((,class (:weight bold :foreground "orange")))) | 742 | `(org-agenda-filter-category ((,class (:weight bold :foreground "orange")))) |
| 743 | `(org-agenda-filter-effort ((,class (:weight bold :foreground "orange")))) | ||
| 744 | `(org-agenda-filter-regexp ((,class (:weight bold :foreground "orange")))) | ||
| 511 | `(org-agenda-filter-tags ((,class (:weight bold :foreground "orange")))) | 745 | `(org-agenda-filter-tags ((,class (:weight bold :foreground "orange")))) |
| 512 | `(org-agenda-restriction-lock ((,class (:background "#E77D63")))) | 746 | `(org-agenda-restriction-lock ((,class (:background "#E77D63")))) |
| 513 | `(org-agenda-structure ((,class (:height 1.6 :weight bold :foreground "#1F8DD6")))) | 747 | `(org-agenda-structure ((,class (,@(leuven-scale-font leuven-scale-org-agenda-structure 1.6) :weight bold :foreground "#1F8DD6")))) |
| 514 | `(org-archived ((,class (:foreground "gray70")))) | 748 | `(org-archived ((,class (:foreground "gray70")))) |
| 515 | `(org-beamer-tag ((,class (:box (:line-width 1 :color "#FABC18") :foreground "#2C2C2C" :background "#FFF8D0")))) | 749 | `(org-beamer-tag ((,class (:box (:line-width 1 :color "#FABC18") :foreground "#2C2C2C" :background "#FFF8D0")))) |
| 516 | `(org-block ((,class ,code-block))) | 750 | `(org-block ((,class ,code-block))) |
| 517 | `(org-block-background ((,class (:background "#FFFFE0")))) | 751 | `(org-block-background ((,class (:background "#FFFFE0")))) ;; :inherit fixed-pitch)))) |
| 518 | `(org-block-begin-line ((,class (:underline "#A7A6AA" :foreground "#555555" :background "#E2E1D5")))) | 752 | `(org-block-begin-line ((,class (:underline "#A7A6AA" :foreground "#555555" :background "#E2E1D5")))) |
| 519 | `(org-block-end-line ((,class (:overline "#A7A6AA" :foreground "#555555" :background "#E2E1D5")))) | 753 | `(org-block-end-line ((,class (:overline "#A7A6AA" :foreground "#555555" :background "#E2E1D5")))) |
| 520 | `(org-checkbox ((,class (:weight bold :box (:line-width 1 :style pressed-button) :foreground "white" :background "#777777")))) | 754 | `(org-checkbox ((,class (:weight bold :box (:line-width 1 :style pressed-button) :foreground "#123555" :background "#A3A3A3")))) |
| 521 | `(org-clock-overlay ((,class (:foreground "white" :background "SkyBlue4")))) | 755 | `(org-clock-overlay ((,class (:foreground "white" :background "SkyBlue4")))) |
| 522 | `(org-code ((,class ,code-inline))) | 756 | `(org-code ((,class ,code-inline))) |
| 523 | `(org-column ((,class ,column))) | 757 | `(org-column ((,class ,column))) |
| @@ -527,14 +761,14 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 527 | `(org-dim ((,class (:foreground "#AAAAAA")))) | 761 | `(org-dim ((,class (:foreground "#AAAAAA")))) |
| 528 | `(org-document-info ((,class (:foreground "#484848")))) | 762 | `(org-document-info ((,class (:foreground "#484848")))) |
| 529 | `(org-document-info-keyword ((,class (:foreground "#008ED1" :background "#EAEAFF")))) | 763 | `(org-document-info-keyword ((,class (:foreground "#008ED1" :background "#EAEAFF")))) |
| 530 | `(org-document-title ((,class (:family "Sans Serif" :height 1.8 :weight bold :foreground "black")))) | 764 | `(org-document-title ((,class (:height 1.8 :weight bold :foreground "black")))) |
| 531 | `(org-done ((,class (:weight bold :box (:line-width 1 :color "#BBBBBB") :foreground "#BBBBBB" :background "#F0F0F0")))) | 765 | `(org-done ((,class (:weight bold :box (:line-width 1 :color "#BBBBBB") :foreground "#BBBBBB" :background "#F0F0F0")))) |
| 532 | `(org-drawer ((,class (:foreground "light sky blue")))) | 766 | `(org-drawer ((,class (:weight bold :foreground "#00BB00" :background "#EAFFEA" :extend nil)))) |
| 533 | `(org-ellipsis ((,class (:underline nil :box (:line-width 1 :color "#999999") :foreground "#999999" :background "#FFF8C0")))) ; #FFEE62 | 767 | `(org-ellipsis ((,class (:underline nil :foreground "#999999")))) ; #FFEE62 |
| 534 | `(org-example ((,class (:foreground "blue" :background "#EAFFEA")))) | 768 | `(org-example ((,class (:foreground "blue" :background "#EAFFEA")))) |
| 535 | `(org-footnote ((,class (:underline t :foreground "#008ED1")))) | 769 | `(org-footnote ((,class (:underline t :foreground "#008ED1")))) |
| 536 | `(org-formula ((,class (:foreground "chocolate1")))) | 770 | `(org-formula ((,class (:foreground "chocolate1")))) |
| 537 | `(org-headline-done ((,class (:height 1.0 :weight normal :strike-through t :foreground "#ADADAD")))) | 771 | `(org-headline-done ((,class (:height 1.0 :weight normal :foreground "#ADADAD")))) |
| 538 | `(org-hide ((,class (:foreground "#E2E2E2")))) | 772 | `(org-hide ((,class (:foreground "#E2E2E2")))) |
| 539 | `(org-inlinetask ((,class (:box (:line-width 1 :color "#EBEBEB") :foreground "#777777" :background "#FFFFD6")))) | 773 | `(org-inlinetask ((,class (:box (:line-width 1 :color "#EBEBEB") :foreground "#777777" :background "#FFFFD6")))) |
| 540 | `(org-latex-and-related ((,class (:foreground "#336699" :background "white")))) | 774 | `(org-latex-and-related ((,class (:foreground "#336699" :background "white")))) |
| @@ -548,25 +782,25 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 548 | `(org-level-8 ((,class ,ol8))) | 782 | `(org-level-8 ((,class ,ol8))) |
| 549 | `(org-link ((,class ,link))) | 783 | `(org-link ((,class ,link))) |
| 550 | `(org-list-dt ((,class (:weight bold :foreground "#335EA8")))) | 784 | `(org-list-dt ((,class (:weight bold :foreground "#335EA8")))) |
| 551 | `(org-macro ((,class (:foreground "white" :background "#EDB802")))) | 785 | `(org-macro ((,class (:weight bold :foreground "#EDB802")))) |
| 552 | `(org-meta-line ((,class (:slant normal :foreground "#008ED1" :background "#EAEAFF")))) | 786 | `(org-meta-line ((,class (:slant normal :foreground "#008ED1" :background "#EAEAFF")))) |
| 553 | `(org-mode-line-clock ((,class ,clock-line))) | 787 | `(org-mode-line-clock ((,class (:box (:line-width 1 :color "#335EA8") :foreground "black" :background "#FFA335")))) |
| 554 | `(org-mode-line-clock-overrun ((,class (:weight bold :box (:line-width 1 :color "#335EA8") :foreground "white" :background "#FF4040")))) | 788 | `(org-mode-line-clock-overrun ((,class (:weight bold :box (:line-width 1 :color "#335EA8") :foreground "white" :background "#FF4040")))) |
| 555 | `(org-number-of-items ((,class (:weight bold :foreground "white" :background "#79BA79")))) | 789 | `(org-number-of-items ((,class (:weight bold :foreground "white" :background "#79BA79")))) |
| 556 | `(org-property-value ((,class (:foreground "#00A000")))) | 790 | `(org-property-value ((,class (:foreground "#00A000")))) |
| 557 | `(org-quote ((,class (:slant italic :foreground "dim gray" :background "#FFFFE0")))) | 791 | `(org-quote ((,class (:slant italic :foreground "dim gray" :background "#FFFFE0")))) |
| 558 | `(org-scheduled ((,class (:foreground "#333333")))) | 792 | `(org-scheduled ((,class (:foreground "#333333")))) |
| 559 | `(org-scheduled-previously ((,class (:foreground "#F22659")))) | 793 | `(org-scheduled-previously ((,class (:foreground "#1466C6")))) |
| 560 | `(org-scheduled-today ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) | 794 | `(org-scheduled-today ((,class (:weight bold :foreground "#4F4A3D" :background "#FFFFCC")))) |
| 561 | `(org-sexp-date ((,class (:foreground "#3774CC")))) | 795 | `(org-sexp-date ((,class (:foreground "#3774CC")))) |
| 562 | `(org-special-keyword ((,class (:weight bold :foreground "#00BB00" :background "#EAFFEA")))) | 796 | `(org-special-keyword ((,class (:weight bold :foreground "#00BB00" :background "#EAFFEA")))) |
| 563 | `(org-table ((,class (:foreground "dark green" :background "#EAFFEA")))) | 797 | `(org-table ((,class (:foreground "dark green" :background "#EAFFEA")))) ;; :inherit fixed-pitch)))) |
| 564 | `(org-tag ((,class (:weight normal :slant italic :foreground "#9A9FA4" :background "white")))) | 798 | `(org-tag ((,class (:weight normal :slant italic :foreground "#9A9FA4" :background "white")))) |
| 565 | `(org-target ((,class ,link))) | 799 | `(org-target ((,class (:foreground "#FF6DAF")))) |
| 566 | `(org-time-grid ((,class (:foreground "#CFCFCF")))) | 800 | `(org-time-grid ((,class (:foreground "#CFCFCF")))) |
| 567 | `(org-todo ((,class (:weight bold :box (:line-width 1 :color "#D8ABA7") :foreground "#D8ABA7" :background "#FFE6E4")))) | 801 | `(org-todo ((,class (:weight bold :box (:line-width 1 :color "#D8ABA7") :foreground "#D8ABA7" :background "#FFE6E4")))) |
| 568 | `(org-upcoming-deadline ((,class (:foreground "#FF5555")))) | 802 | `(org-upcoming-deadline ((,class (:foreground "#FF5555")))) |
| 569 | `(org-verbatim ((,class (:foreground "#0066CC")))) | 803 | `(org-verbatim ((,class (:foreground "#0066CC" :background "#F7FDFF")))) |
| 570 | `(org-verse ((,class (:slant italic :foreground "dim gray" :background "#EEEEEE")))) | 804 | `(org-verse ((,class (:slant italic :foreground "dim gray" :background "#EEEEEE")))) |
| 571 | `(org-warning ((,class (:weight bold :foreground "black" :background "#CCE7FF")))) | 805 | `(org-warning ((,class (:weight bold :foreground "black" :background "#CCE7FF")))) |
| 572 | `(outline-1 ((,class ,ol1))) | 806 | `(outline-1 ((,class ,ol1))) |
| @@ -577,17 +811,17 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 577 | `(outline-6 ((,class ,ol6))) | 811 | `(outline-6 ((,class ,ol6))) |
| 578 | `(outline-7 ((,class ,ol7))) | 812 | `(outline-7 ((,class ,ol7))) |
| 579 | `(outline-8 ((,class ,ol8))) | 813 | `(outline-8 ((,class ,ol8))) |
| 580 | `(pabbrev-debug-display-label-face ((,class (:background "chartreuse")))) | 814 | `(pabbrev-debug-display-label-face ((,class (:foreground "white" :background "#A62154")))) |
| 581 | `(pabbrev-suggestions-face ((,class (:weight bold :foreground "white" :background "red")))) | 815 | `(pabbrev-suggestions-face ((,class (:weight bold :foreground "white" :background "red")))) |
| 582 | `(pabbrev-suggestions-label-face ((,class (:weight bold :foreground "white" :background "purple")))) | 816 | `(pabbrev-suggestions-label-face ((,class (:weight bold :foreground "white" :background "purple")))) |
| 583 | `(paren-face-match ((,class ,paren-matched))) | 817 | `(paren-face-match ((,class ,paren-matched))) |
| 584 | `(paren-face-mismatch ((,class ,paren-unmatched))) | 818 | `(paren-face-mismatch ((,class ,paren-unmatched))) |
| 585 | `(paren-face-no-match ((,class ,paren-unmatched))) | 819 | `(paren-face-no-match ((,class ,paren-unmatched))) |
| 586 | `(persp-selected-face ((,class (:weight bold :foreground "#EEF5FE")))) | 820 | `(persp-selected-face ((,class (:weight bold :foreground "#EEF5FE")))) |
| 587 | `(powerline-active1 ((,class (:background "grey22" :inherit mode-line)))) | 821 | `(powerline-active1 ((,class (:foreground "#85CEEB" :background "#383838" :inherit mode-line)))) |
| 588 | `(powerline-active2 ((,class (:background "#4070B6" :inherit mode-line)))) | 822 | `(powerline-active2 ((,class (:foreground "#85CEEB" :background "#4070B6" :inherit mode-line)))) |
| 589 | `(powerline-inactive1 ((,class (:background "#686868" :inherit mode-line-inactive)))) | 823 | `(powerline-inactive1 ((,class (:foreground "#F0F0EF" :background "#686868" :inherit mode-line-inactive)))) |
| 590 | `(powerline-inactive2 ((,class (:background "#A9A9A9" :inherit mode-line-inactive)))) | 824 | `(powerline-inactive2 ((,class (:foreground "#F0F0EF" :background "#A9A9A9" :inherit mode-line-inactive)))) |
| 591 | `(rainbow-delimiters-depth-1-face ((,class (:foreground "#707183")))) | 825 | `(rainbow-delimiters-depth-1-face ((,class (:foreground "#707183")))) |
| 592 | `(rainbow-delimiters-depth-2-face ((,class (:foreground "#7388D6")))) | 826 | `(rainbow-delimiters-depth-2-face ((,class (:foreground "#7388D6")))) |
| 593 | `(rainbow-delimiters-depth-3-face ((,class (:foreground "#909183")))) | 827 | `(rainbow-delimiters-depth-3-face ((,class (:foreground "#909183")))) |
| @@ -599,29 +833,33 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 599 | `(rainbow-delimiters-depth-9-face ((,class (:foreground "#887070")))) | 833 | `(rainbow-delimiters-depth-9-face ((,class (:foreground "#887070")))) |
| 600 | `(rainbow-delimiters-mismatched-face ((,class ,paren-unmatched))) | 834 | `(rainbow-delimiters-mismatched-face ((,class ,paren-unmatched))) |
| 601 | `(rainbow-delimiters-unmatched-face ((,class ,paren-unmatched))) | 835 | `(rainbow-delimiters-unmatched-face ((,class ,paren-unmatched))) |
| 602 | `(realgud-overlay-arrow1 ((,class (:foreground "#005522")))) | ||
| 603 | `(realgud-overlay-arrow2 ((,class (:foreground "#c18401")))) | ||
| 604 | `(realgud-overlay-arrow3 ((,class (:foreground "#909183")))) | ||
| 605 | `(realgud-bp-disabled-face ((,class (:foreground "#909183")))) | ||
| 606 | `(realgud-bp-line-enabled-face ((,class (:underline "red")))) | ||
| 607 | `(realgud-bp-line-disabled-face ((,class (:underline "#909183")))) | ||
| 608 | `(realgud-file-name ((,class :foreground "#005522"))) | ||
| 609 | `(realgud-line-number ((,class :foreground "#A535AE"))) | ||
| 610 | `(realgud-backtrace-number ((,class :foreground "#A535AE" :weight bold))) | ||
| 611 | `(recover-this-file ((,class (:weight bold :background "#FF3F3F")))) | 836 | `(recover-this-file ((,class (:weight bold :background "#FF3F3F")))) |
| 612 | `(rng-error ((,class (:weight bold :foreground "red" :background "#FBE3E4")))) | 837 | `(rng-error ((,class (:weight bold :foreground "red" :background "#FBE3E4")))) |
| 613 | `(sh-heredoc ((,class (:foreground "blue" :background "#EEF5FE")))) | 838 | `(sh-heredoc ((,class (:foreground "blue" :background "#EEF5FE")))) |
| 614 | `(sh-quoted-exec ((,class (:foreground "#FF1493")))) | 839 | `(sh-quoted-exec ((,class (:foreground "#FF1493")))) |
| 615 | `(shadow ((,class ,shadow))) | 840 | `(shadow ((,class ,shadow))) ; Used for grep context lines. |
| 616 | `(shell-option-face ((,class (:foreground "forest green")))) | 841 | `(shell-option-face ((,class (:foreground "forest green")))) |
| 617 | `(shell-output-2-face ((,class (:foreground "blue")))) | 842 | `(shell-output-2-face ((,class (:foreground "blue")))) |
| 618 | `(shell-output-3-face ((,class (:foreground "purple")))) | 843 | `(shell-output-3-face ((,class (:foreground "purple")))) |
| 619 | `(shell-output-face ((,class (:foreground "black")))) | 844 | `(shell-output-face ((,class (:foreground "black")))) |
| 620 | ;; `(shell-prompt-face ((,class (:weight bold :foreground "yellow")))) | 845 | ;; `(shell-prompt-face ((,class (:weight bold :foreground "yellow")))) |
| 846 | `(shm-current-face ((,class (:background "#EEE8D5")))) | ||
| 847 | `(shm-quarantine-face ((,class (:background "lemonchiffon")))) | ||
| 621 | `(show-paren-match ((,class ,paren-matched))) | 848 | `(show-paren-match ((,class ,paren-matched))) |
| 622 | `(show-paren-mismatch ((,class ,paren-unmatched))) | 849 | `(show-paren-mismatch ((,class ,paren-unmatched))) |
| 623 | `(sml-modeline-end-face ((,class (:background "#6BADF6")))) ; #335EA8 | 850 | `(sml-modeline-end-face ((,class (:background "#6BADF6")))) ; #335EA8 |
| 624 | `(sml-modeline-vis-face ((,class (:background "#1979CA")))) | 851 | `(sml-modeline-vis-face ((,class (:background "#1979CA")))) |
| 852 | `(term ((,class (:foreground "#333333" :background "#FFFFFF")))) | ||
| 853 | |||
| 854 | ;; `(sp-pair-overlay-face ((,class ()))) | ||
| 855 | ;; `(sp-show-pair-enclosing ((,class ()))) | ||
| 856 | ;; `(sp-show-pair-match-face ((,class ()))) ; ~ Pair highlighting (matching tags). | ||
| 857 | ;; `(sp-show-pair-mismatch-face ((,class ()))) | ||
| 858 | ;; `(sp-wrap-overlay-closing-pair ((,class ()))) | ||
| 859 | ;; `(sp-wrap-overlay-face ((,class ()))) | ||
| 860 | ;; `(sp-wrap-overlay-opening-pair ((,class ()))) | ||
| 861 | ;; `(sp-wrap-tag-overlay-face ((,class ()))) | ||
| 862 | |||
| 625 | `(speedbar-button-face ((,class (:foreground "green4")))) | 863 | `(speedbar-button-face ((,class (:foreground "green4")))) |
| 626 | `(speedbar-directory-face ((,class (:foreground "blue4")))) | 864 | `(speedbar-directory-face ((,class (:foreground "blue4")))) |
| 627 | `(speedbar-file-face ((,class (:foreground "cyan4")))) | 865 | `(speedbar-file-face ((,class (:foreground "cyan4")))) |
| @@ -639,7 +877,6 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 639 | `(tex-verbatim ((,class (:foreground "blue")))) | 877 | `(tex-verbatim ((,class (:foreground "blue")))) |
| 640 | `(tool-bar ((,class (:box (:line-width 1 :style released-button) :foreground "black" :background "gray75")))) | 878 | `(tool-bar ((,class (:box (:line-width 1 :style released-button) :foreground "black" :background "gray75")))) |
| 641 | `(tooltip ((,class (:foreground "black" :background "light yellow")))) | 879 | `(tooltip ((,class (:foreground "black" :background "light yellow")))) |
| 642 | `(trailing-whitespace ((,class (:background "#F6EBFE")))) | ||
| 643 | `(traverse-match-face ((,class (:weight bold :foreground "blue violet")))) | 880 | `(traverse-match-face ((,class (:weight bold :foreground "blue violet")))) |
| 644 | `(vc-annotate-face-3F3FFF ((,class (:foreground "#3F3FFF" :background "black")))) | 881 | `(vc-annotate-face-3F3FFF ((,class (:foreground "#3F3FFF" :background "black")))) |
| 645 | `(vc-annotate-face-3F6CFF ((,class (:foreground "#3F3FFF" :background "black")))) | 882 | `(vc-annotate-face-3F6CFF ((,class (:foreground "#3F3FFF" :background "black")))) |
| @@ -654,11 +891,24 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 654 | `(vc-annotate-face-83FF3F ((,class (:foreground "#B0FF3F" :background "black")))) | 891 | `(vc-annotate-face-83FF3F ((,class (:foreground "#B0FF3F" :background "black")))) |
| 655 | `(vc-annotate-face-B0FF3F ((,class (:foreground "#B0FF3F" :background "black")))) | 892 | `(vc-annotate-face-B0FF3F ((,class (:foreground "#B0FF3F" :background "black")))) |
| 656 | `(vc-annotate-face-DDFF3F ((,class (:foreground "#FFF33F" :background "black")))) | 893 | `(vc-annotate-face-DDFF3F ((,class (:foreground "#FFF33F" :background "black")))) |
| 894 | `(vc-annotate-face-F6FFCC ((,class (:foreground "black" :background "#FFFFC0")))) | ||
| 657 | `(vc-annotate-face-FF3F3F ((,class (:foreground "#FF3F3F" :background "black")))) | 895 | `(vc-annotate-face-FF3F3F ((,class (:foreground "#FF3F3F" :background "black")))) |
| 658 | `(vc-annotate-face-FF6C3F ((,class (:foreground "#FF3F3F" :background "black")))) | 896 | `(vc-annotate-face-FF6C3F ((,class (:foreground "#FF3F3F" :background "black")))) |
| 659 | `(vc-annotate-face-FF993F ((,class (:foreground "#FF993F" :background "black")))) | 897 | `(vc-annotate-face-FF993F ((,class (:foreground "#FF993F" :background "black")))) |
| 660 | `(vc-annotate-face-FFC63F ((,class (:foreground "#FF993F" :background "black")))) | 898 | `(vc-annotate-face-FFC63F ((,class (:foreground "#FF993F" :background "black")))) |
| 661 | `(vc-annotate-face-FFF33F ((,class (:foreground "#FFF33F" :background "black")))) | 899 | `(vc-annotate-face-FFF33F ((,class (:foreground "#FFF33F" :background "black")))) |
| 900 | |||
| 901 | ;; ;; vc | ||
| 902 | ;; (vc-up-to-date-state ((,c :foreground ,(gc 'green-1)))) | ||
| 903 | ;; (vc-edited-state ((,c :foreground ,(gc 'yellow+1)))) | ||
| 904 | ;; (vc-missing-state ((,c :foreground ,(gc 'red)))) | ||
| 905 | ;; (vc-conflict-state ((,c :foreground ,(gc 'red+2) :weight bold))) | ||
| 906 | ;; (vc-locked-state ((,c :foreground ,(gc 'cyan-1)))) | ||
| 907 | ;; (vc-locally-added-state ((,c :foreground ,(gc 'blue)))) | ||
| 908 | ;; (vc-needs-update-state ((,c :foreground ,(gc 'magenta)))) | ||
| 909 | ;; (vc-removed-state ((,c :foreground ,(gc 'red-1)))) | ||
| 910 | |||
| 911 | `(vhl/default-face ((,class ,volatile-highlight))) ; `volatile-highlights.el' (for undo, yank). | ||
| 662 | `(w3m-anchor ((,class ,link))) | 912 | `(w3m-anchor ((,class ,link))) |
| 663 | `(w3m-arrived-anchor ((,class (:foreground "purple1")))) | 913 | `(w3m-arrived-anchor ((,class (:foreground "purple1")))) |
| 664 | `(w3m-bitmap-image-face ((,class (:foreground "gray4" :background "green")))) | 914 | `(w3m-bitmap-image-face ((,class (:foreground "gray4" :background "green")))) |
| @@ -675,38 +925,138 @@ Semantic, and Ansi-Color faces are included -- and much more...") | |||
| 675 | `(w3m-link-numbering ((,class (:foreground "#B4C7EB")))) ; mouseless browsing | 925 | `(w3m-link-numbering ((,class (:foreground "#B4C7EB")))) ; mouseless browsing |
| 676 | `(w3m-strike-through-face ((,class (:strike-through t)))) | 926 | `(w3m-strike-through-face ((,class (:strike-through t)))) |
| 677 | `(w3m-underline-face ((,class (:underline t)))) | 927 | `(w3m-underline-face ((,class (:underline t)))) |
| 678 | `(which-func ((,class (:weight bold :foreground "white")))) | 928 | |
| 929 | ;; `(web-mode-block-attr-name-face ((,class ()))) | ||
| 930 | ;; `(web-mode-block-attr-value-face ((,class ()))) | ||
| 931 | ;; `(web-mode-block-comment-face ((,class ()))) | ||
| 932 | ;; `(web-mode-block-control-face ((,class ()))) | ||
| 933 | ;; `(web-mode-block-delimiter-face ((,class ()))) | ||
| 934 | ;; `(web-mode-block-face ((,class ()))) | ||
| 935 | ;; `(web-mode-block-string-face ((,class ()))) | ||
| 936 | ;; `(web-mode-bold-face ((,class ()))) | ||
| 937 | ;; `(web-mode-builtin-face ((,class ()))) | ||
| 938 | ;; `(web-mode-comment-face ((,class ()))) | ||
| 939 | ;; `(web-mode-comment-keyword-face ((,class ()))) | ||
| 940 | ;; `(web-mode-constant-face ((,class ()))) | ||
| 941 | ;; `(web-mode-css-at-rule-face ((,class ()))) | ||
| 942 | ;; `(web-mode-css-color-face ((,class ()))) | ||
| 943 | ;; `(web-mode-css-comment-face ((,class ()))) | ||
| 944 | ;; `(web-mode-css-function-face ((,class ()))) | ||
| 945 | ;; `(web-mode-css-priority-face ((,class ()))) | ||
| 946 | ;; `(web-mode-css-property-name-face ((,class ()))) | ||
| 947 | ;; `(web-mode-css-pseudo-class-face ((,class ()))) | ||
| 948 | ;; `(web-mode-css-selector-face ((,class ()))) | ||
| 949 | ;; `(web-mode-css-string-face ((,class ()))) | ||
| 950 | ;; `(web-mode-css-variable-face ((,class ()))) | ||
| 951 | ;; `(web-mode-current-column-highlight-face ((,class ()))) | ||
| 952 | `(web-mode-current-element-highlight-face ((,class (:background "#99CCFF")))) ; #FFEE80 | ||
| 953 | ;; `(web-mode-doctype-face ((,class ()))) | ||
| 954 | ;; `(web-mode-error-face ((,class ()))) | ||
| 955 | ;; `(web-mode-filter-face ((,class ()))) | ||
| 956 | `(web-mode-folded-face ((,class (:box (:line-width 1 :color "#777777") :foreground "#9A9A6A" :background "#F3F349")))) | ||
| 957 | ;; `(web-mode-function-call-face ((,class ()))) | ||
| 958 | ;; `(web-mode-function-name-face ((,class ()))) | ||
| 959 | ;; `(web-mode-html-attr-custom-face ((,class ()))) | ||
| 960 | ;; `(web-mode-html-attr-engine-face ((,class ()))) | ||
| 961 | ;; `(web-mode-html-attr-equal-face ((,class ()))) | ||
| 962 | `(web-mode-html-attr-name-face ((,class ,xml-attribute))) | ||
| 963 | ;; `(web-mode-html-attr-value-face ((,class ()))) | ||
| 964 | ;; `(web-mode-html-entity-face ((,class ()))) | ||
| 965 | `(web-mode-html-tag-bracket-face ((,class ,xml-tag))) | ||
| 966 | ;; `(web-mode-html-tag-custom-face ((,class ()))) | ||
| 967 | `(web-mode-html-tag-face ((,class ,xml-tag))) | ||
| 968 | ;; `(web-mode-html-tag-namespaced-face ((,class ()))) | ||
| 969 | ;; `(web-mode-inlay-face ((,class ()))) | ||
| 970 | ;; `(web-mode-italic-face ((,class ()))) | ||
| 971 | ;; `(web-mode-javascript-comment-face ((,class ()))) | ||
| 972 | ;; `(web-mode-javascript-string-face ((,class ()))) | ||
| 973 | ;; `(web-mode-json-comment-face ((,class ()))) | ||
| 974 | ;; `(web-mode-json-context-face ((,class ()))) | ||
| 975 | ;; `(web-mode-json-key-face ((,class ()))) | ||
| 976 | ;; `(web-mode-json-string-face ((,class ()))) | ||
| 977 | ;; `(web-mode-jsx-depth-1-face ((,class ()))) | ||
| 978 | ;; `(web-mode-jsx-depth-2-face ((,class ()))) | ||
| 979 | ;; `(web-mode-jsx-depth-3-face ((,class ()))) | ||
| 980 | ;; `(web-mode-jsx-depth-4-face ((,class ()))) | ||
| 981 | ;; `(web-mode-keyword-face ((,class ()))) | ||
| 982 | ;; `(web-mode-param-name-face ((,class ()))) | ||
| 983 | ;; `(web-mode-part-comment-face ((,class ()))) | ||
| 984 | `(web-mode-part-face ((,class (:background "#FFFFE0")))) | ||
| 985 | ;; `(web-mode-part-string-face ((,class ()))) | ||
| 986 | ;; `(web-mode-preprocessor-face ((,class ()))) | ||
| 987 | `(web-mode-script-face ((,class (:background "#EFF0F1")))) | ||
| 988 | ;; `(web-mode-sql-keyword-face ((,class ()))) | ||
| 989 | ;; `(web-mode-string-face ((,class ()))) | ||
| 990 | ;; `(web-mode-style-face ((,class ()))) | ||
| 991 | ;; `(web-mode-symbol-face ((,class ()))) | ||
| 992 | ;; `(web-mode-type-face ((,class ()))) | ||
| 993 | ;; `(web-mode-underline-face ((,class ()))) | ||
| 994 | ;; `(web-mode-variable-name-face ((,class ()))) | ||
| 995 | ;; `(web-mode-warning-face ((,class ()))) | ||
| 996 | ;; `(web-mode-whitespace-face ((,class ()))) | ||
| 997 | |||
| 998 | `(which-func ((,class (:weight bold :slant italic :foreground "white")))) | ||
| 999 | ;; `(which-key-command-description-face) | ||
| 1000 | ;; `(which-key-group-description-face) | ||
| 1001 | ;; `(which-key-highlighted-command-face) | ||
| 1002 | ;; `(which-key-key-face) | ||
| 1003 | `(which-key-local-map-description-face ((,class (:weight bold :background "#F3F7FC" :inherit which-key-command-description-face)))) | ||
| 1004 | ;; `(which-key-note-face) | ||
| 1005 | ;; `(which-key-separator-face) | ||
| 1006 | ;; `(which-key-special-key-face) | ||
| 679 | `(widget-button ((,class ,link))) | 1007 | `(widget-button ((,class ,link))) |
| 680 | `(widget-button-pressed ((,class (:foreground "red")))) | 1008 | `(widget-button-pressed ((,class (:foreground "red")))) |
| 681 | `(widget-documentation ((,class (:foreground "green4")))) | 1009 | `(widget-documentation ((,class (:foreground "green4")))) |
| 682 | `(widget-field ((,class (:background "gray85")))) | 1010 | `(widget-field ((,class (:background "gray85")))) |
| 683 | `(widget-inactive ((,class (:foreground "dim gray")))) | 1011 | `(widget-inactive ((,class (:foreground "dim gray")))) |
| 684 | `(widget-single-line-field ((,class (:background "gray85")))) | 1012 | `(widget-single-line-field ((,class (:background "gray85")))) |
| 685 | `(yas/field-debug-face ((,class (:background "ivory2")))) | 1013 | `(woman-bold ((,class (:weight bold :foreground "#F13D3D")))) |
| 686 | `(yas/field-highlight-face ((,class (:background "DarkSeaGreen1")))) | 1014 | `(woman-italic ((,class (:weight bold :slant italic :foreground "#46BE1B")))) |
| 1015 | `(woman-symbol ((,class (:weight bold :foreground "purple")))) | ||
| 1016 | `(yas-field-debug-face ((,class (:foreground "white" :background "#A62154")))) | ||
| 1017 | `(yas-field-highlight-face ((,class (:box (:line-width 1 :color "#838383") :foreground "black" :background "#D4DCD8")))) | ||
| 1018 | |||
| 1019 | ;; `(ztreep-arrow-face ((,class ()))) | ||
| 1020 | ;; `(ztreep-diff-header-face ((,class ()))) | ||
| 1021 | ;; `(ztreep-diff-header-small-face ((,class ()))) | ||
| 1022 | `(ztreep-diff-model-add-face ((,class (:weight bold :foreground "#008800")))) | ||
| 1023 | `(ztreep-diff-model-diff-face ((,class (:weight bold :foreground "#0044DD")))) | ||
| 1024 | `(ztreep-diff-model-ignored-face ((,class (:strike-through t :foreground "#9E9E9E")))) | ||
| 1025 | `(ztreep-diff-model-normal-face ((,class (:foreground "#000000")))) | ||
| 1026 | ;; `(ztreep-expand-sign-face ((,class ()))) | ||
| 1027 | ;; `(ztreep-header-face ((,class ()))) | ||
| 1028 | ;; `(ztreep-leaf-face ((,class ()))) | ||
| 1029 | ;; `(ztreep-node-face ((,class ()))) | ||
| 1030 | |||
| 687 | )) | 1031 | )) |
| 688 | 1032 | ||
| 689 | (custom-theme-set-variables 'leuven | 1033 | (custom-theme-set-variables 'leuven |
| 690 | '(ansi-color-faces-vector | 1034 | |
| 691 | [default default default italic underline success warning error]) | 1035 | ;; highlight-sexp-mode. |
| 692 | '(ansi-color-names-vector | 1036 | '(hl-sexp-background-color "#efebe9") |
| 693 | ["black" "red3" "ForestGreen" "yellow3" "blue" "magenta3" "DeepSkyBlue" "gray50"]) | 1037 | |
| 694 | ; colors used in Shell mode | 1038 | '(ansi-color-faces-vector |
| 1039 | [default default default italic underline success warning error]) | ||
| 1040 | |||
| 1041 | ;; Colors used in Shell mode. | ||
| 1042 | '(ansi-color-names-vector | ||
| 1043 | ["black" "red3" "ForestGreen" "yellow3" "blue" "magenta3" "DeepSkyBlue" "gray50"]) | ||
| 695 | ) | 1044 | ) |
| 696 | 1045 | ||
| 697 | ;;;###autoload | 1046 | ;;;###autoload |
| 698 | (when (and (boundp 'custom-theme-load-path) | 1047 | (when (and (boundp 'custom-theme-load-path) |
| 699 | load-file-name) | 1048 | load-file-name) |
| 700 | ;; add theme folder to `custom-theme-load-path' when installing over MELPA | 1049 | ;; Add theme folder to `custom-theme-load-path' when installing over MELPA. |
| 701 | (add-to-list 'custom-theme-load-path | 1050 | (add-to-list 'custom-theme-load-path |
| 702 | (file-name-as-directory (file-name-directory load-file-name)))) | 1051 | (file-name-as-directory (file-name-directory load-file-name)))) |
| 703 | 1052 | ||
| 704 | (provide-theme 'leuven) | 1053 | (provide-theme 'leuven) |
| 705 | 1054 | ||
| 1055 | ;; This is for the sake of Emacs. | ||
| 706 | ;; Local Variables: | 1056 | ;; Local Variables: |
| 1057 | ;; time-stamp-end: "$" | ||
| 707 | ;; time-stamp-format: "%:y%02m%02d.%02H%02M" | 1058 | ;; time-stamp-format: "%:y%02m%02d.%02H%02M" |
| 708 | ;; time-stamp-start: "Version: " | 1059 | ;; time-stamp-start: "Version: " |
| 709 | ;; time-stamp-end: "$" | ||
| 710 | ;; End: | 1060 | ;; End: |
| 711 | 1061 | ||
| 712 | ;;; leuven-theme.el ends here | 1062 | ;;; leuven-theme.el ends here |
diff --git a/etc/tutorials/TUTORIAL b/etc/tutorials/TUTORIAL index eb3acde9c01..227c13f3e3a 100644 --- a/etc/tutorials/TUTORIAL +++ b/etc/tutorials/TUTORIAL | |||
| @@ -612,11 +612,11 @@ but it also means that you need a convenient way to save the first | |||
| 612 | file's buffer. Having to switch back to that buffer, in order to save | 612 | file's buffer. Having to switch back to that buffer, in order to save |
| 613 | it with C-x C-s, would be a nuisance. So we have | 613 | it with C-x C-s, would be a nuisance. So we have |
| 614 | 614 | ||
| 615 | C-x s Save some buffers | 615 | C-x s Save some buffers to their files |
| 616 | 616 | ||
| 617 | C-x s asks you about each buffer which contains changes that you have | 617 | C-x s asks you about each file-visiting buffer which contains changes |
| 618 | not saved. It asks you, for each such buffer, whether to save the | 618 | that you have not saved. It asks you, for each such buffer, whether |
| 619 | buffer. | 619 | to save the buffer to its file. |
| 620 | 620 | ||
| 621 | >> Insert a line of text, then type C-x s. | 621 | >> Insert a line of text, then type C-x s. |
| 622 | It should ask you whether to save the buffer named TUTORIAL. | 622 | It should ask you whether to save the buffer named TUTORIAL. |
| @@ -660,8 +660,8 @@ as by a mail handling utility. | |||
| 660 | There are many C-x commands. Here is a list of the ones you have learned: | 660 | There are many C-x commands. Here is a list of the ones you have learned: |
| 661 | 661 | ||
| 662 | C-x C-f Find file | 662 | C-x C-f Find file |
| 663 | C-x C-s Save file | 663 | C-x C-s Save buffer to file |
| 664 | C-x s Save some buffers | 664 | C-x s Save some buffers to their files |
| 665 | C-x C-b List buffers | 665 | C-x C-b List buffers |
| 666 | C-x b Switch buffer | 666 | C-x b Switch buffer |
| 667 | C-x C-c Quit Emacs | 667 | C-x C-c Quit Emacs |
| @@ -1081,7 +1081,7 @@ corresponding command names (such as C-x C-f beside find-file). | |||
| 1081 | You can learn more about Emacs by reading its manual, either as a | 1081 | You can learn more about Emacs by reading its manual, either as a |
| 1082 | printed book, or inside Emacs (use the Help menu or type C-h r). | 1082 | printed book, or inside Emacs (use the Help menu or type C-h r). |
| 1083 | Two features that you may like especially are completion, which saves | 1083 | Two features that you may like especially are completion, which saves |
| 1084 | typing, and dired, which simplifies file handling. | 1084 | typing, and Dired, which simplifies file handling. |
| 1085 | 1085 | ||
| 1086 | Completion is a way to avoid unnecessary typing. For instance, if you | 1086 | Completion is a way to avoid unnecessary typing. For instance, if you |
| 1087 | want to switch to the *Messages* buffer, you can type C-x b *M<Tab> | 1087 | want to switch to the *Messages* buffer, you can type C-x b *M<Tab> |
diff --git a/lib/c++defs.h b/lib/c++defs.h index 3e6aaabc9ce..182c2b3a88d 100644 --- a/lib/c++defs.h +++ b/lib/c++defs.h | |||
| @@ -268,7 +268,7 @@ | |||
| 268 | _GL_CXXALIASWARN_2 (func, namespace) | 268 | _GL_CXXALIASWARN_2 (func, namespace) |
| 269 | /* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>, | 269 | /* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>, |
| 270 | we enable the warning only when not optimizing. */ | 270 | we enable the warning only when not optimizing. */ |
| 271 | # if !__OPTIMIZE__ | 271 | # if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__) |
| 272 | # define _GL_CXXALIASWARN_2(func,namespace) \ | 272 | # define _GL_CXXALIASWARN_2(func,namespace) \ |
| 273 | _GL_WARN_ON_USE (func, \ | 273 | _GL_WARN_ON_USE (func, \ |
| 274 | "The symbol ::" #func " refers to the system function. " \ | 274 | "The symbol ::" #func " refers to the system function. " \ |
| @@ -296,7 +296,7 @@ | |||
| 296 | _GL_CXXALIASWARN1_2 (func, rettype, parameters_and_attributes, namespace) | 296 | _GL_CXXALIASWARN1_2 (func, rettype, parameters_and_attributes, namespace) |
| 297 | /* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>, | 297 | /* To work around GCC bug <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=43881>, |
| 298 | we enable the warning only when not optimizing. */ | 298 | we enable the warning only when not optimizing. */ |
| 299 | # if !__OPTIMIZE__ | 299 | # if !(defined __GNUC__ && !defined __clang__ && __OPTIMIZE__) |
| 300 | # define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \ | 300 | # define _GL_CXXALIASWARN1_2(func,rettype,parameters_and_attributes,namespace) \ |
| 301 | _GL_WARN_ON_USE_CXX (func, rettype, parameters_and_attributes, \ | 301 | _GL_WARN_ON_USE_CXX (func, rettype, parameters_and_attributes, \ |
| 302 | "The symbol ::" #func " refers to the system function. " \ | 302 | "The symbol ::" #func " refers to the system function. " \ |
diff --git a/lib/cdefs.h b/lib/cdefs.h index d8e4a000333..f6c447ad377 100644 --- a/lib/cdefs.h +++ b/lib/cdefs.h | |||
| @@ -401,7 +401,7 @@ | |||
| 401 | # endif | 401 | # endif |
| 402 | #endif | 402 | #endif |
| 403 | 403 | ||
| 404 | #if __GNUC__ >= 3 | 404 | #if (__GNUC__ >= 3) || (__clang_major__ >= 4) |
| 405 | # define __glibc_unlikely(cond) __builtin_expect ((cond), 0) | 405 | # define __glibc_unlikely(cond) __builtin_expect ((cond), 0) |
| 406 | # define __glibc_likely(cond) __builtin_expect ((cond), 1) | 406 | # define __glibc_likely(cond) __builtin_expect ((cond), 1) |
| 407 | #else | 407 | #else |
diff --git a/lib/count-leading-zeros.h b/lib/count-leading-zeros.h index 7e88c8cb9d0..7cf605a5f64 100644 --- a/lib/count-leading-zeros.h +++ b/lib/count-leading-zeros.h | |||
| @@ -38,7 +38,8 @@ extern "C" { | |||
| 38 | expand to code that computes the number of leading zeros of the local | 38 | expand to code that computes the number of leading zeros of the local |
| 39 | variable 'x' of type TYPE (an unsigned integer type) and return it | 39 | variable 'x' of type TYPE (an unsigned integer type) and return it |
| 40 | from the current function. */ | 40 | from the current function. */ |
| 41 | #if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) | 41 | #if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \ |
| 42 | || (__clang_major__ >= 4) | ||
| 42 | # define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ | 43 | # define COUNT_LEADING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ |
| 43 | return x ? BUILTIN (x) : CHAR_BIT * sizeof x; | 44 | return x ? BUILTIN (x) : CHAR_BIT * sizeof x; |
| 44 | #elif _MSC_VER | 45 | #elif _MSC_VER |
diff --git a/lib/count-trailing-zeros.h b/lib/count-trailing-zeros.h index 1eb5fb919f4..727b21dcc56 100644 --- a/lib/count-trailing-zeros.h +++ b/lib/count-trailing-zeros.h | |||
| @@ -38,7 +38,8 @@ extern "C" { | |||
| 38 | expand to code that computes the number of trailing zeros of the local | 38 | expand to code that computes the number of trailing zeros of the local |
| 39 | variable 'x' of type TYPE (an unsigned integer type) and return it | 39 | variable 'x' of type TYPE (an unsigned integer type) and return it |
| 40 | from the current function. */ | 40 | from the current function. */ |
| 41 | #if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) | 41 | #if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) \ |
| 42 | || (__clang_major__ >= 4) | ||
| 42 | # define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ | 43 | # define COUNT_TRAILING_ZEROS(BUILTIN, MSC_BUILTIN, TYPE) \ |
| 43 | return x ? BUILTIN (x) : CHAR_BIT * sizeof x; | 44 | return x ? BUILTIN (x) : CHAR_BIT * sizeof x; |
| 44 | #elif _MSC_VER | 45 | #elif _MSC_VER |
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in index 4dc180d2e33..92d0621c61a 100644 --- a/lib/gnulib.mk.in +++ b/lib/gnulib.mk.in | |||
| @@ -246,9 +246,10 @@ GL_GENERATE_ALLOCA_H = @GL_GENERATE_ALLOCA_H@ | |||
| 246 | GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@ | 246 | GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@ |
| 247 | GL_GENERATE_ERRNO_H = @GL_GENERATE_ERRNO_H@ | 247 | GL_GENERATE_ERRNO_H = @GL_GENERATE_ERRNO_H@ |
| 248 | GL_GENERATE_EXECINFO_H = @GL_GENERATE_EXECINFO_H@ | 248 | GL_GENERATE_EXECINFO_H = @GL_GENERATE_EXECINFO_H@ |
| 249 | GL_GENERATE_GMP_H = @GL_GENERATE_GMP_H@ | 249 | GL_GENERATE_GMP_GMP_H = @GL_GENERATE_GMP_GMP_H@ |
| 250 | GL_GENERATE_IEEE754_H = @GL_GENERATE_IEEE754_H@ | 250 | GL_GENERATE_IEEE754_H = @GL_GENERATE_IEEE754_H@ |
| 251 | GL_GENERATE_LIMITS_H = @GL_GENERATE_LIMITS_H@ | 251 | GL_GENERATE_LIMITS_H = @GL_GENERATE_LIMITS_H@ |
| 252 | GL_GENERATE_MINI_GMP_H = @GL_GENERATE_MINI_GMP_H@ | ||
| 252 | GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@ | 253 | GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@ |
| 253 | GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@ | 254 | GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@ |
| 254 | GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@ | 255 | GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@ |
| @@ -1085,7 +1086,6 @@ gamedir = @gamedir@ | |||
| 1085 | gamegroup = @gamegroup@ | 1086 | gamegroup = @gamegroup@ |
| 1086 | gameuser = @gameuser@ | 1087 | gameuser = @gameuser@ |
| 1087 | gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 = @gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7@ | 1088 | gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 = @gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7@ |
| 1088 | gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9 = @gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9@ | ||
| 1089 | gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b = @gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b@ | 1089 | gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b = @gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b@ |
| 1090 | gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@ | 1090 | gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@ |
| 1091 | gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c@ | 1091 | gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c@ |
| @@ -2021,15 +2021,22 @@ ifeq (,$(OMIT_GNULIB_MODULE_libgmp)) | |||
| 2021 | 2021 | ||
| 2022 | BUILT_SOURCES += $(GMP_H) | 2022 | BUILT_SOURCES += $(GMP_H) |
| 2023 | 2023 | ||
| 2024 | ifneq (,$(GL_GENERATE_MINI_GMP_H)) | ||
| 2024 | # Build gmp.h as a wrapper for mini-gmp.h when using mini-gmp. | 2025 | # Build gmp.h as a wrapper for mini-gmp.h when using mini-gmp. |
| 2025 | ifneq (,$(GL_GENERATE_GMP_H)) | ||
| 2026 | gmp.h: $(top_builddir)/config.status | 2026 | gmp.h: $(top_builddir)/config.status |
| 2027 | echo '#include "mini-gmp.h"' >$@-t | 2027 | echo '#include "mini-gmp.h"' >$@-t |
| 2028 | mv $@-t $@ | 2028 | mv $@-t $@ |
| 2029 | else | 2029 | else |
| 2030 | ifneq (,$(GL_GENERATE_GMP_GMP_H)) | ||
| 2031 | # Build gmp.h as a wrapper for gmp/gmp.h. | ||
| 2032 | gmp.h: $(top_builddir)/config.status | ||
| 2033 | echo '#include <gmp/gmp.h>' >$@-t | ||
| 2034 | mv $@-t $@ | ||
| 2035 | else | ||
| 2030 | gmp.h: $(top_builddir)/config.status | 2036 | gmp.h: $(top_builddir)/config.status |
| 2031 | rm -f $@ | 2037 | rm -f $@ |
| 2032 | endif | 2038 | endif |
| 2039 | endif | ||
| 2033 | MOSTLYCLEANFILES += gmp.h gmp.h-t | 2040 | MOSTLYCLEANFILES += gmp.h gmp.h-t |
| 2034 | 2041 | ||
| 2035 | EXTRA_DIST += mini-gmp-gnulib.c mini-gmp.c mini-gmp.h | 2042 | EXTRA_DIST += mini-gmp-gnulib.c mini-gmp.c mini-gmp.h |
diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 035720b49b7..9bcceceb0ee 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in | |||
| @@ -205,7 +205,6 @@ $(lisp)/finder-inf.el: | |||
| 205 | 205 | ||
| 206 | autoloads .PHONY: $(lisp)/loaddefs.el | 206 | autoloads .PHONY: $(lisp)/loaddefs.el |
| 207 | $(lisp)/loaddefs.el: gen-lisp $(LOADDEFS) | 207 | $(lisp)/loaddefs.el: gen-lisp $(LOADDEFS) |
| 208 | @echo Directories for loaddefs: ${SUBDIRS_ALMOST} | ||
| 209 | $(AM_V_GEN)$(emacs) -l autoload \ | 208 | $(AM_V_GEN)$(emacs) -l autoload \ |
| 210 | --eval '(setq autoload-ensure-writable t)' \ | 209 | --eval '(setq autoload-ensure-writable t)' \ |
| 211 | --eval '(setq autoload-builtin-package-versions t)' \ | 210 | --eval '(setq autoload-builtin-package-versions t)' \ |
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 6781c292d82..ae85fc55add 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el | |||
| @@ -391,6 +391,7 @@ file. Archive and member name will be added." | |||
| 391 | (define-key map "e" 'archive-extract) | 391 | (define-key map "e" 'archive-extract) |
| 392 | (define-key map "f" 'archive-extract) | 392 | (define-key map "f" 'archive-extract) |
| 393 | (define-key map "\C-m" 'archive-extract) | 393 | (define-key map "\C-m" 'archive-extract) |
| 394 | (define-key map "C" 'archive-copy-file) | ||
| 394 | (define-key map "m" 'archive-mark) | 395 | (define-key map "m" 'archive-mark) |
| 395 | (define-key map "n" 'archive-next-line) | 396 | (define-key map "n" 'archive-next-line) |
| 396 | (define-key map "\C-n" 'archive-next-line) | 397 | (define-key map "\C-n" 'archive-next-line) |
| @@ -430,6 +431,9 @@ file. Archive and member name will be added." | |||
| 430 | (define-key map [menu-bar immediate view] | 431 | (define-key map [menu-bar immediate view] |
| 431 | '(menu-item "View This File" archive-view | 432 | '(menu-item "View This File" archive-view |
| 432 | :help "Display file at cursor in View Mode")) | 433 | :help "Display file at cursor in View Mode")) |
| 434 | (define-key map [menu-bar immediate view] | ||
| 435 | '(menu-item "Copy This File" archive-copy-file | ||
| 436 | :help "Copy file at cursor to another location")) | ||
| 433 | (define-key map [menu-bar immediate display] | 437 | (define-key map [menu-bar immediate display] |
| 434 | '(menu-item "Display in Other Window" archive-display-other-window | 438 | '(menu-item "Display in Other Window" archive-display-other-window |
| 435 | :help "Display file at cursor in another window")) | 439 | :help "Display file at cursor in another window")) |
| @@ -989,6 +993,75 @@ using `make-temp-file', and the generated name is returned." | |||
| 989 | (kill-local-variable 'buffer-file-coding-system) | 993 | (kill-local-variable 'buffer-file-coding-system) |
| 990 | (after-insert-file-set-coding (- (point-max) (point-min)))))) | 994 | (after-insert-file-set-coding (- (point-max) (point-min)))))) |
| 991 | 995 | ||
| 996 | (defun archive-goto-file (file) | ||
| 997 | "Go to FILE in the current buffer. | ||
| 998 | FILE should be a relative file name. If FILE can't be found, | ||
| 999 | return nil. Otherwise point is returned." | ||
| 1000 | (let ((start (point)) | ||
| 1001 | found) | ||
| 1002 | (goto-char (point-min)) | ||
| 1003 | (while (and (not found) | ||
| 1004 | (not (eobp))) | ||
| 1005 | (forward-line 1) | ||
| 1006 | (when-let ((descr (archive-get-descr t))) | ||
| 1007 | (when (equal (archive--file-desc-ext-file-name descr) file) | ||
| 1008 | (setq found t)))) | ||
| 1009 | (if (not found) | ||
| 1010 | (progn | ||
| 1011 | (goto-char start) | ||
| 1012 | nil) | ||
| 1013 | (point)))) | ||
| 1014 | |||
| 1015 | (defun archive-next-file-displayer (file regexp n) | ||
| 1016 | "Return a closure to display the next file after FILE that matches REGEXP." | ||
| 1017 | (let ((short (replace-regexp-in-string "\\`.*:" "" file)) | ||
| 1018 | next) | ||
| 1019 | (archive-goto-file short) | ||
| 1020 | (while (and (not next) | ||
| 1021 | ;; Stop if we reach the end/start of the buffer. | ||
| 1022 | (if (> n 0) | ||
| 1023 | (not (eobp)) | ||
| 1024 | (not (save-excursion | ||
| 1025 | (beginning-of-line) | ||
| 1026 | (bobp))))) | ||
| 1027 | (archive-next-line n) | ||
| 1028 | (when-let ((descr (archive-get-descr t))) | ||
| 1029 | (let ((candidate (archive--file-desc-ext-file-name descr)) | ||
| 1030 | (buffer (current-buffer))) | ||
| 1031 | (when (and candidate | ||
| 1032 | (string-match-p regexp candidate)) | ||
| 1033 | (setq next (lambda () | ||
| 1034 | (kill-buffer (current-buffer)) | ||
| 1035 | (switch-to-buffer buffer) | ||
| 1036 | (archive-extract))))))) | ||
| 1037 | (unless next | ||
| 1038 | ;; If we didn't find a next/prev file, then restore | ||
| 1039 | ;; point. | ||
| 1040 | (archive-goto-file short)) | ||
| 1041 | next)) | ||
| 1042 | |||
| 1043 | (defun archive-copy-file (file new-name) | ||
| 1044 | "Copy FILE to a location specified by NEW-NAME. | ||
| 1045 | Interactively, FILE is the file at point, and the function prompts | ||
| 1046 | for NEW-NAME." | ||
| 1047 | (interactive | ||
| 1048 | (let ((name (archive--file-desc-ext-file-name (archive-get-descr)))) | ||
| 1049 | (list name | ||
| 1050 | (read-file-name (format "Copy %s to: " name))))) | ||
| 1051 | (when (file-directory-p new-name) | ||
| 1052 | (setq new-name (expand-file-name file new-name))) | ||
| 1053 | (when (and (file-exists-p new-name) | ||
| 1054 | (not (yes-or-no-p (format "%s already exists; overwrite? " | ||
| 1055 | new-name)))) | ||
| 1056 | (user-error "Not overwriting %s" new-name)) | ||
| 1057 | (let* ((descr (archive-get-descr)) | ||
| 1058 | (archive (buffer-file-name)) | ||
| 1059 | (extractor (archive-name "extract")) | ||
| 1060 | (ename (archive--file-desc-ext-file-name descr))) | ||
| 1061 | (with-temp-buffer | ||
| 1062 | (archive--extract-file extractor archive ename) | ||
| 1063 | (write-region (point-min) (point-max) new-name)))) | ||
| 1064 | |||
| 992 | (defun archive-extract (&optional other-window-p event) | 1065 | (defun archive-extract (&optional other-window-p event) |
| 993 | "In archive mode, extract this entry of the archive into its own buffer." | 1066 | "In archive mode, extract this entry of the archive into its own buffer." |
| 994 | (interactive (list nil last-input-event)) | 1067 | (interactive (list nil last-input-event)) |
| @@ -1030,26 +1103,7 @@ using `make-temp-file', and the generated name is returned." | |||
| 1030 | (setq archive-subfile-mode descr) | 1103 | (setq archive-subfile-mode descr) |
| 1031 | (setq archive-file-name-coding-system file-name-coding) | 1104 | (setq archive-file-name-coding-system file-name-coding) |
| 1032 | (if (and | 1105 | (if (and |
| 1033 | (null | 1106 | (null (archive--extract-file extractor archive ename)) |
| 1034 | (let (;; We may have to encode the file name argument for | ||
| 1035 | ;; external programs. | ||
| 1036 | (coding-system-for-write | ||
| 1037 | (and enable-multibyte-characters | ||
| 1038 | archive-file-name-coding-system)) | ||
| 1039 | ;; We read an archive member by no-conversion at | ||
| 1040 | ;; first, then decode appropriately by calling | ||
| 1041 | ;; archive-set-buffer-as-visiting-file later. | ||
| 1042 | (coding-system-for-read 'no-conversion) | ||
| 1043 | ;; Avoid changing dir mtime by lock_file | ||
| 1044 | (create-lockfiles nil)) | ||
| 1045 | (condition-case err | ||
| 1046 | (if (fboundp extractor) | ||
| 1047 | (funcall extractor archive ename) | ||
| 1048 | (archive-*-extract archive ename | ||
| 1049 | (symbol-value extractor))) | ||
| 1050 | (error | ||
| 1051 | (ding (message "%s" (error-message-string err))) | ||
| 1052 | nil)))) | ||
| 1053 | just-created) | 1107 | just-created) |
| 1054 | (progn | 1108 | (progn |
| 1055 | (set-buffer-modified-p nil) | 1109 | (set-buffer-modified-p nil) |
| @@ -1082,6 +1136,27 @@ using `make-temp-file', and the generated name is returned." | |||
| 1082 | (other-window-p (switch-to-buffer-other-window buffer)) | 1136 | (other-window-p (switch-to-buffer-other-window buffer)) |
| 1083 | (t (switch-to-buffer buffer)))))) | 1137 | (t (switch-to-buffer buffer)))))) |
| 1084 | 1138 | ||
| 1139 | (defun archive--extract-file (extractor archive ename) | ||
| 1140 | (let (;; We may have to encode the file name argument for | ||
| 1141 | ;; external programs. | ||
| 1142 | (coding-system-for-write | ||
| 1143 | (and enable-multibyte-characters | ||
| 1144 | archive-file-name-coding-system)) | ||
| 1145 | ;; We read an archive member by no-conversion at | ||
| 1146 | ;; first, then decode appropriately by calling | ||
| 1147 | ;; archive-set-buffer-as-visiting-file later. | ||
| 1148 | (coding-system-for-read 'no-conversion) | ||
| 1149 | ;; Avoid changing dir mtime by lock_file | ||
| 1150 | (create-lockfiles nil)) | ||
| 1151 | (condition-case err | ||
| 1152 | (if (fboundp extractor) | ||
| 1153 | (funcall extractor archive ename) | ||
| 1154 | (archive-*-extract archive ename | ||
| 1155 | (symbol-value extractor))) | ||
| 1156 | (error | ||
| 1157 | (ding (message "%s" (error-message-string err))) | ||
| 1158 | nil)))) | ||
| 1159 | |||
| 1085 | (defun archive-*-extract (archive name command) | 1160 | (defun archive-*-extract (archive name command) |
| 1086 | (let* ((default-directory (file-name-as-directory archive-tmpdir)) | 1161 | (let* ((default-directory (file-name-as-directory archive-tmpdir)) |
| 1087 | (tmpfile (expand-file-name (file-name-nondirectory name) | 1162 | (tmpfile (expand-file-name (file-name-nondirectory name) |
diff --git a/lisp/bookmark.el b/lisp/bookmark.el index de7d60f97eb..fb293adb779 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el | |||
| @@ -1667,6 +1667,19 @@ Don't affect the buffer ring order." | |||
| 1667 | 1667 | ||
| 1668 | 1668 | ||
| 1669 | ;;;###autoload | 1669 | ;;;###autoload |
| 1670 | (defun bookmark-bmenu-get-buffer () | ||
| 1671 | "Return the Bookmark List, building it if it doesn't exists. | ||
| 1672 | Don't affect the buffer ring order." | ||
| 1673 | (or (get-buffer bookmark-bmenu-buffer) | ||
| 1674 | (save-excursion | ||
| 1675 | (save-window-excursion | ||
| 1676 | (bookmark-bmenu-list) | ||
| 1677 | (get-buffer bookmark-bmenu-buffer))))) | ||
| 1678 | |||
| 1679 | (custom-add-choice 'tab-bar-new-tab-choice | ||
| 1680 | '(const :tag "Bookmark List" bookmark-bmenu-get-buffer)) | ||
| 1681 | |||
| 1682 | ;;;###autoload | ||
| 1670 | (defun bookmark-bmenu-list () | 1683 | (defun bookmark-bmenu-list () |
| 1671 | "Display a list of existing bookmarks. | 1684 | "Display a list of existing bookmarks. |
| 1672 | The list is displayed in a buffer named `*Bookmark List*'. | 1685 | The list is displayed in a buffer named `*Bookmark List*'. |
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 655a76a713c..aa5c47ca7f4 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el | |||
| @@ -69,11 +69,26 @@ minus `Buffer-menu-size-width'. This use is deprecated." | |||
| 69 | "use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead." | 69 | "use `Buffer-menu-name-width' and `Buffer-menu-size-width' instead." |
| 70 | "24.3") | 70 | "24.3") |
| 71 | 71 | ||
| 72 | (defcustom Buffer-menu-name-width 19 | 72 | (defun Buffer-menu--dynamic-name-width (buffers) |
| 73 | "Width of buffer name column in the Buffer Menu." | 73 | "Return a name column width based on the current window width. |
| 74 | :type 'number | 74 | The width will never exceed the actual width of the buffer names, |
| 75 | but will never be narrower than 19 characters." | ||
| 76 | (max 19 | ||
| 77 | ;; This gives 19 on an 80 column window, and take up | ||
| 78 | ;; proportionally more space as the window widens. | ||
| 79 | (min (truncate (/ (window-width) 4.2)) | ||
| 80 | (apply #'max 0 (mapcar (lambda (b) | ||
| 81 | (length (buffer-name b))) | ||
| 82 | buffers))))) | ||
| 83 | |||
| 84 | (defcustom Buffer-menu-name-width #'Buffer-menu--dynamic-name-width | ||
| 85 | "Width of buffer name column in the Buffer Menu. | ||
| 86 | This can either be a number (used directly) or a function that | ||
| 87 | will be called with the list of buffers and should return a | ||
| 88 | number." | ||
| 89 | :type '(choice function number) | ||
| 75 | :group 'Buffer-menu | 90 | :group 'Buffer-menu |
| 76 | :version "24.3") | 91 | :version "28.1") |
| 77 | 92 | ||
| 78 | (defcustom Buffer-menu-size-width 7 | 93 | (defcustom Buffer-menu-size-width 7 |
| 79 | "Width of buffer size column in the Buffer Menu." | 94 | "Width of buffer size column in the Buffer Menu." |
| @@ -488,8 +503,9 @@ Buffers marked with \\<Buffer-menu-mode-map>`\\[Buffer-menu-delete]' are deleted | |||
| 488 | (defun Buffer-menu-select () | 503 | (defun Buffer-menu-select () |
| 489 | "Select this line's buffer; also, display buffers marked with `>'. | 504 | "Select this line's buffer; also, display buffers marked with `>'. |
| 490 | You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command. | 505 | You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command. |
| 506 | |||
| 491 | This command deletes and replaces all the previously existing windows | 507 | This command deletes and replaces all the previously existing windows |
| 492 | in the selected frame." | 508 | in the selected frame, and will remove any marks." |
| 493 | (interactive) | 509 | (interactive) |
| 494 | (let* ((this-buffer (Buffer-menu-buffer t)) | 510 | (let* ((this-buffer (Buffer-menu-buffer t)) |
| 495 | (menu-buffer (current-buffer)) | 511 | (menu-buffer (current-buffer)) |
| @@ -645,25 +661,11 @@ means list those buffers and no others." | |||
| 645 | 661 | ||
| 646 | (defun list-buffers--refresh (&optional buffer-list old-buffer) | 662 | (defun list-buffers--refresh (&optional buffer-list old-buffer) |
| 647 | ;; Set up `tabulated-list-format'. | 663 | ;; Set up `tabulated-list-format'. |
| 648 | (let ((name-width Buffer-menu-name-width) | 664 | (let ((size-width Buffer-menu-size-width) |
| 649 | (size-width Buffer-menu-size-width) | ||
| 650 | (marked-buffers (Buffer-menu-marked-buffers)) | 665 | (marked-buffers (Buffer-menu-marked-buffers)) |
| 651 | (buffer-menu-buffer (current-buffer)) | 666 | (buffer-menu-buffer (current-buffer)) |
| 652 | (show-non-file (not Buffer-menu-files-only)) | 667 | (show-non-file (not Buffer-menu-files-only)) |
| 653 | entries) | 668 | entries name-width) |
| 654 | ;; Handle obsolete variable: | ||
| 655 | (if Buffer-menu-buffer+size-width | ||
| 656 | (setq name-width (- Buffer-menu-buffer+size-width size-width))) | ||
| 657 | (setq tabulated-list-format | ||
| 658 | (vector '("C" 1 t :pad-right 0) | ||
| 659 | '("R" 1 t :pad-right 0) | ||
| 660 | '("M" 1 t) | ||
| 661 | `("Buffer" ,name-width t) | ||
| 662 | `("Size" ,size-width tabulated-list-entry-size-> | ||
| 663 | :right-align t) | ||
| 664 | `("Mode" ,Buffer-menu-mode-width t) | ||
| 665 | '("File" 1 t))) | ||
| 666 | (setq tabulated-list-use-header-line Buffer-menu-use-header-line) | ||
| 667 | ;; Collect info for each buffer we're interested in. | 669 | ;; Collect info for each buffer we're interested in. |
| 668 | (dolist (buffer (or buffer-list | 670 | (dolist (buffer (or buffer-list |
| 669 | (buffer-list (if Buffer-menu-use-frame-buffer-list | 671 | (buffer-list (if Buffer-menu-use-frame-buffer-list |
| @@ -693,6 +695,22 @@ means list those buffers and no others." | |||
| 693 | nil nil buffer))) | 695 | nil nil buffer))) |
| 694 | (Buffer-menu--pretty-file-name file))) | 696 | (Buffer-menu--pretty-file-name file))) |
| 695 | entries))))) | 697 | entries))))) |
| 698 | (setq name-width (if (functionp Buffer-menu-name-width) | ||
| 699 | (funcall Buffer-menu-name-width (mapcar #'car entries)) | ||
| 700 | Buffer-menu-name-width)) | ||
| 701 | ;; Handle obsolete variable: | ||
| 702 | (if Buffer-menu-buffer+size-width | ||
| 703 | (setq name-width (- Buffer-menu-buffer+size-width size-width))) | ||
| 704 | (setq tabulated-list-format | ||
| 705 | (vector '("C" 1 t :pad-right 0) | ||
| 706 | '("R" 1 t :pad-right 0) | ||
| 707 | '("M" 1 t) | ||
| 708 | `("Buffer" ,name-width t) | ||
| 709 | `("Size" ,size-width tabulated-list-entry-size-> | ||
| 710 | :right-align t) | ||
| 711 | `("Mode" ,Buffer-menu-mode-width t) | ||
| 712 | '("File" 1 t))) | ||
| 713 | (setq tabulated-list-use-header-line Buffer-menu-use-header-line) | ||
| 696 | (setq tabulated-list-entries (nreverse entries))) | 714 | (setq tabulated-list-entries (nreverse entries))) |
| 697 | (tabulated-list-init-header)) | 715 | (tabulated-list-init-header)) |
| 698 | 716 | ||
diff --git a/lisp/button.el b/lisp/button.el index d9c36a0375c..03ab59b109c 100644 --- a/lisp/button.el +++ b/lisp/button.el | |||
| @@ -464,8 +464,12 @@ see). | |||
| 464 | POS defaults to point, except when `push-button' is invoked | 464 | POS defaults to point, except when `push-button' is invoked |
| 465 | interactively as the result of a mouse-event, in which case, the | 465 | interactively as the result of a mouse-event, in which case, the |
| 466 | mouse event is used. | 466 | mouse event is used. |
| 467 | |||
| 467 | If there's no button at POS, do nothing and return nil, otherwise | 468 | If there's no button at POS, do nothing and return nil, otherwise |
| 468 | return t." | 469 | return t. |
| 470 | |||
| 471 | To get a description of what function will called when pushing a | ||
| 472 | butting, use the `button-describe' command." | ||
| 469 | (interactive | 473 | (interactive |
| 470 | (list (if (integerp last-command-event) (point) last-command-event))) | 474 | (list (if (integerp last-command-event) (point) last-command-event))) |
| 471 | (if (and (not (integerp pos)) (eventp pos)) | 475 | (if (and (not (integerp pos)) (eventp pos)) |
| @@ -555,6 +559,51 @@ Returns the button found." | |||
| 555 | (interactive "p\nd\nd") | 559 | (interactive "p\nd\nd") |
| 556 | (forward-button (- n) wrap display-message no-error)) | 560 | (forward-button (- n) wrap display-message no-error)) |
| 557 | 561 | ||
| 562 | (defun button--describe (properties) | ||
| 563 | "Describe a button's PROPERTIES (an alist) in a *Help* buffer. | ||
| 564 | This is a helper function for `button-describe', in order to be possible to | ||
| 565 | use `help-setup-xref'. | ||
| 566 | |||
| 567 | Each element of PROPERTIES should be of the form (PROPERTY . VALUE)." | ||
| 568 | (help-setup-xref (list #'button--describe properties) | ||
| 569 | (called-interactively-p 'interactive)) | ||
| 570 | (with-help-window (help-buffer) | ||
| 571 | (with-current-buffer (help-buffer) | ||
| 572 | (insert (format-message "This button's type is `%s'." | ||
| 573 | (alist-get 'type properties))) | ||
| 574 | (dolist (prop '(action mouse-action)) | ||
| 575 | (let ((name (symbol-name prop)) | ||
| 576 | (val (alist-get prop properties))) | ||
| 577 | (when (functionp val) | ||
| 578 | (insert "\n\n" | ||
| 579 | (propertize (capitalize name) 'face 'bold) | ||
| 580 | "\nThe " name " of this button is") | ||
| 581 | (if (symbolp val) | ||
| 582 | (progn | ||
| 583 | (insert (format-message " `%s',\nwhich is " val)) | ||
| 584 | (describe-function-1 val)) | ||
| 585 | (insert "\n") | ||
| 586 | (princ val)))))))) | ||
| 587 | |||
| 588 | (defun button-describe (&optional button-or-pos) | ||
| 589 | "Display a buffer with information about the button at point. | ||
| 590 | |||
| 591 | When called from Lisp, pass BUTTON-OR-POS as the button to describe, or a | ||
| 592 | buffer position where a button is present. If BUTTON-OR-POS is nil, the | ||
| 593 | button at point is the button to describe." | ||
| 594 | (interactive "d") | ||
| 595 | (let* ((button (cond ((integer-or-marker-p button-or-pos) | ||
| 596 | (button-at button-or-pos)) | ||
| 597 | ((null button-or-pos) (button-at (point))) | ||
| 598 | ((overlayp button-or-pos) button-or-pos))) | ||
| 599 | (props (and button | ||
| 600 | (mapcar (lambda (prop) | ||
| 601 | (cons prop (button-get button prop))) | ||
| 602 | '(type action mouse-action))))) | ||
| 603 | (when props | ||
| 604 | (button--describe props) | ||
| 605 | t))) | ||
| 606 | |||
| 558 | (provide 'button) | 607 | (provide 'button) |
| 559 | 608 | ||
| 560 | ;;; button.el ends here | 609 | ;;; button.el ends here |
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index 3db12e668ab..af6acaf09ad 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el | |||
| @@ -350,17 +350,29 @@ If the locale never uses daylight saving time, set this to 0." | |||
| 350 | :group 'calendar-dst) | 350 | :group 'calendar-dst) |
| 351 | 351 | ||
| 352 | (defcustom calendar-standard-time-zone-name | 352 | (defcustom calendar-standard-time-zone-name |
| 353 | (or (nth 2 calendar-current-time-zone-cache) "EST") | 353 | (if calendar-use-numeric-time-zones |
| 354 | (if calendar-current-time-zone-cache | ||
| 355 | (format-time-string | ||
| 356 | "%z" 0 (* 60 (car calendar-current-time-zone-cache))) | ||
| 357 | "+0000") | ||
| 358 | (or (nth 2 calendar-current-time-zone-cache) "EST")) | ||
| 354 | "Abbreviated name of standard time zone at `calendar-location-name'. | 359 | "Abbreviated name of standard time zone at `calendar-location-name'. |
| 355 | For example, \"EST\" in New York City, \"PST\" for Los Angeles." | 360 | For example, \"EST\" in New York City, \"PST\" for Los Angeles." |
| 356 | :type 'string | 361 | :type 'string |
| 362 | :version "28.1" | ||
| 357 | :group 'calendar-dst) | 363 | :group 'calendar-dst) |
| 358 | 364 | ||
| 359 | (defcustom calendar-daylight-time-zone-name | 365 | (defcustom calendar-daylight-time-zone-name |
| 360 | (or (nth 3 calendar-current-time-zone-cache) "EDT") | 366 | (if calendar-use-numeric-time-zones |
| 367 | (if calendar-current-time-zone-cache | ||
| 368 | (format-time-string | ||
| 369 | "%z" 0 (* 60 (cadr calendar-current-time-zone-cache))) | ||
| 370 | "+0000") | ||
| 371 | (or (nth 3 calendar-current-time-zone-cache) "EDT")) | ||
| 361 | "Abbreviated name of daylight saving time zone at `calendar-location-name'. | 372 | "Abbreviated name of daylight saving time zone at `calendar-location-name'. |
| 362 | For example, \"EDT\" in New York City, \"PDT\" for Los Angeles." | 373 | For example, \"EDT\" in New York City, \"PDT\" for Los Angeles." |
| 363 | :type 'string | 374 | :type 'string |
| 375 | :version "28.1" | ||
| 364 | :group 'calendar-dst) | 376 | :group 'calendar-dst) |
| 365 | 377 | ||
| 366 | (defcustom calendar-daylight-savings-starts-time | 378 | (defcustom calendar-daylight-savings-starts-time |
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el index 1d5b9479e2b..0efb2bc6607 100644 --- a/lisp/calendar/calendar.el +++ b/lisp/calendar/calendar.el | |||
| @@ -1061,6 +1061,13 @@ calendar." | |||
| 1061 | :type 'boolean | 1061 | :type 'boolean |
| 1062 | :group 'holidays) | 1062 | :group 'holidays) |
| 1063 | 1063 | ||
| 1064 | (defcustom calendar-use-numeric-time-zones nil | ||
| 1065 | "If nil, use symbolic time zones like \"CET\" when displaying dates. | ||
| 1066 | If non-nil, use numeric time zones like \"+0100\"." | ||
| 1067 | :type 'boolean | ||
| 1068 | :version "28.1" | ||
| 1069 | :group 'calendar) | ||
| 1070 | |||
| 1064 | ;;; End of user options. | 1071 | ;;; End of user options. |
| 1065 | 1072 | ||
| 1066 | (calendar-recompute-layout-variables) | 1073 | (calendar-recompute-layout-variables) |
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 6a813e9ee82..635bdd8f11c 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el | |||
| @@ -209,7 +209,6 @@ Returns nil if nothing was entered." | |||
| 209 | 209 | ||
| 210 | (defun solar-setup () | 210 | (defun solar-setup () |
| 211 | "Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'." | 211 | "Prompt for `calendar-longitude', `calendar-latitude', `calendar-time-zone'." |
| 212 | (beep) | ||
| 213 | (or calendar-longitude | 212 | (or calendar-longitude |
| 214 | (setq calendar-longitude | 213 | (setq calendar-longitude |
| 215 | (solar-get-number | 214 | (solar-get-number |
| @@ -840,7 +839,9 @@ This function is suitable for execution in an init file." | |||
| 840 | "E" "W")))))) | 839 | "E" "W")))))) |
| 841 | (calendar-standard-time-zone-name | 840 | (calendar-standard-time-zone-name |
| 842 | (if (< arg 16) calendar-standard-time-zone-name | 841 | (if (< arg 16) calendar-standard-time-zone-name |
| 843 | (cond ((zerop calendar-time-zone) "UTC") | 842 | (cond ((zerop calendar-time-zone) |
| 843 | (if calendar-use-numeric-time-zones | ||
| 844 | "+0100" "UTC")) | ||
| 844 | ((< calendar-time-zone 0) | 845 | ((< calendar-time-zone 0) |
| 845 | (format "UTC%dmin" calendar-time-zone)) | 846 | (format "UTC%dmin" calendar-time-zone)) |
| 846 | (t (format "UTC+%dmin" calendar-time-zone))))) | 847 | (t (format "UTC+%dmin" calendar-time-zone))))) |
| @@ -1013,7 +1014,10 @@ Requires floating point." | |||
| 1013 | (let* ((m displayed-month) | 1014 | (let* ((m displayed-month) |
| 1014 | (y displayed-year) | 1015 | (y displayed-year) |
| 1015 | (calendar-standard-time-zone-name | 1016 | (calendar-standard-time-zone-name |
| 1016 | (if calendar-time-zone calendar-standard-time-zone-name "UTC")) | 1017 | (cond |
| 1018 | (calendar-time-zone calendar-standard-time-zone-name) | ||
| 1019 | (calendar-use-numeric-time-zones "+0100") | ||
| 1020 | (t "UTC"))) | ||
| 1017 | (calendar-daylight-savings-starts | 1021 | (calendar-daylight-savings-starts |
| 1018 | (if calendar-time-zone calendar-daylight-savings-starts)) | 1022 | (if calendar-time-zone calendar-daylight-savings-starts)) |
| 1019 | (calendar-daylight-savings-ends | 1023 | (calendar-daylight-savings-ends |
diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index eeb09926a6e..125f9acc705 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el | |||
| @@ -527,6 +527,21 @@ TIME is modified and returned." | |||
| 527 | 527 | ||
| 528 | time) | 528 | time) |
| 529 | 529 | ||
| 530 | (defun decoded-time-period (time) | ||
| 531 | "Interpret DECODED as a period and return its length in seconds. | ||
| 532 | For computational purposes, years are 365 days long and months | ||
| 533 | are 30 days long." | ||
| 534 | (+ (if (consp (decoded-time-second time)) | ||
| 535 | ;; Fractional second. | ||
| 536 | (/ (float (car (decoded-time-second time))) | ||
| 537 | (cdr (decoded-time-second time))) | ||
| 538 | (or (decoded-time-second time) 0)) | ||
| 539 | (* (or (decoded-time-minute time) 0) 60) | ||
| 540 | (* (or (decoded-time-hour time) 0) 60 60) | ||
| 541 | (* (or (decoded-time-day time) 0) 60 60 24) | ||
| 542 | (* (or (decoded-time-month time) 0) 60 60 24 30) | ||
| 543 | (* (or (decoded-time-year time) 0) 60 60 24 365))) | ||
| 544 | |||
| 530 | (provide 'time-date) | 545 | (provide 'time-date) |
| 531 | 546 | ||
| 532 | ;;; time-date.el ends here | 547 | ;;; time-date.el ends here |
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index e2c2ebe5f42..7c60916ee01 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el | |||
| @@ -70,7 +70,7 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" | |||
| 70 | (directory-files subdir nil | 70 | (directory-files subdir nil |
| 71 | "\\`[^=.].*\\.el\\'")))) | 71 | "\\`[^=.].*\\.el\\'")))) |
| 72 | (progress (make-progress-reporter | 72 | (progress (make-progress-reporter |
| 73 | (byte-compile-info-string "Scanning files for custom") | 73 | (byte-compile-info "Scanning files for custom") |
| 74 | 0 (length files) nil 10))) | 74 | 0 (length files) nil 10))) |
| 75 | (with-temp-buffer | 75 | (with-temp-buffer |
| 76 | (dolist (elem files) | 76 | (dolist (elem files) |
| @@ -128,8 +128,8 @@ Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" | |||
| 128 | type))))))))))) | 128 | type))))))))))) |
| 129 | (error nil))))))) | 129 | (error nil))))))) |
| 130 | (progress-reporter-done progress)) | 130 | (progress-reporter-done progress)) |
| 131 | (byte-compile-info-message "Generating %s..." | 131 | (byte-compile-info |
| 132 | generated-custom-dependencies-file) | 132 | (format "Generating %s..." generated-custom-dependencies-file) t) |
| 133 | (set-buffer (find-file-noselect generated-custom-dependencies-file)) | 133 | (set-buffer (find-file-noselect generated-custom-dependencies-file)) |
| 134 | (setq buffer-undo-list t) | 134 | (setq buffer-undo-list t) |
| 135 | (erase-buffer) | 135 | (erase-buffer) |
| @@ -218,8 +218,8 @@ elements the files that have variables or faces that contain that | |||
| 218 | version. These files should be loaded before showing the customization | 218 | version. These files should be loaded before showing the customization |
| 219 | buffer that `customize-changed-options' generates.\")\n\n")) | 219 | buffer that `customize-changed-options' generates.\")\n\n")) |
| 220 | (save-buffer) | 220 | (save-buffer) |
| 221 | (byte-compile-info-message "Generating %s...done" | 221 | (byte-compile-info |
| 222 | generated-custom-dependencies-file)) | 222 | (format "Generating %s...done" generated-custom-dependencies-file) t)) |
| 223 | 223 | ||
| 224 | 224 | ||
| 225 | (provide 'cus-dep) | 225 | (provide 'cus-dep) |
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 1942f25e891..16695967dfa 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el | |||
| @@ -4841,7 +4841,10 @@ The format is suitable for use with `easy-menu-define'." | |||
| 4841 | (error "You can't edit this part of the Custom buffer")) | 4841 | (error "You can't edit this part of the Custom buffer")) |
| 4842 | 4842 | ||
| 4843 | (defun Custom-newline (pos &optional event) | 4843 | (defun Custom-newline (pos &optional event) |
| 4844 | "Invoke button at POS, or refuse to allow editing of Custom buffer." | 4844 | "Invoke button at POS, or refuse to allow editing of Custom buffer. |
| 4845 | |||
| 4846 | To see what function the widget will call, use the | ||
| 4847 | `widget-describe' command." | ||
| 4845 | (interactive "@d") | 4848 | (interactive "@d") |
| 4846 | (let ((button (get-char-property pos 'button))) | 4849 | (let ((button (get-char-property pos 'button))) |
| 4847 | ;; If there is no button at point, then use the one at the start | 4850 | ;; If there is no button at point, then use the one at the start |
diff --git a/lisp/custom.el b/lisp/custom.el index 885c486c5e4..db7f6a056d4 100644 --- a/lisp/custom.el +++ b/lisp/custom.el | |||
| @@ -1541,6 +1541,20 @@ Each of the arguments ARGS has this form: | |||
| 1541 | This means reset VARIABLE. (The argument IGNORED is ignored)." | 1541 | This means reset VARIABLE. (The argument IGNORED is ignored)." |
| 1542 | (apply #'custom-theme-reset-variables 'user args)) | 1542 | (apply #'custom-theme-reset-variables 'user args)) |
| 1543 | 1543 | ||
| 1544 | (defun custom-add-choice (variable choice) | ||
| 1545 | "Add CHOICE to the custom type of VARIABLE. | ||
| 1546 | If a choice with the same tag already exists, no action is taken." | ||
| 1547 | (let ((choices (get variable 'custom-type))) | ||
| 1548 | (unless (eq (car choices) 'choice) | ||
| 1549 | (error "Not a choice type: %s" choices)) | ||
| 1550 | (unless (seq-find (lambda (elem) | ||
| 1551 | (equal (caddr (member :tag elem)) | ||
| 1552 | (caddr (member :tag choice)))) | ||
| 1553 | (cdr choices)) | ||
| 1554 | ;; Put the new choice at the end. | ||
| 1555 | (put variable 'custom-type | ||
| 1556 | (append choices (list choice)))))) | ||
| 1557 | |||
| 1544 | ;;; The End. | 1558 | ;;; The End. |
| 1545 | 1559 | ||
| 1546 | (provide 'custom) | 1560 | (provide 'custom) |
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index efb214088d8..84d8c36f45f 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el | |||
| @@ -688,7 +688,7 @@ are executed in the background on each file sequentially waiting | |||
| 688 | for each command to terminate before running the next command. | 688 | for each command to terminate before running the next command. |
| 689 | In shell syntax this means separating the individual commands with `;'. | 689 | In shell syntax this means separating the individual commands with `;'. |
| 690 | 690 | ||
| 691 | The output appears in the buffer `*Async Shell Command*'." | 691 | The output appears in the buffer `shell-command-buffer-name-async'." |
| 692 | (interactive | 692 | (interactive |
| 693 | (let ((files (dired-get-marked-files t current-prefix-arg nil nil t))) | 693 | (let ((files (dired-get-marked-files t current-prefix-arg nil nil t))) |
| 694 | (list | 694 | (list |
| @@ -727,7 +727,7 @@ it, write `*\"\"' in place of just `*'. This is equivalent to just | |||
| 727 | 727 | ||
| 728 | If COMMAND ends in `&', `;', or `;&', it is executed in the | 728 | If COMMAND ends in `&', `;', or `;&', it is executed in the |
| 729 | background asynchronously, and the output appears in the buffer | 729 | background asynchronously, and the output appears in the buffer |
| 730 | `*Async Shell Command*'. When operating on multiple files and COMMAND | 730 | `shell-command-buffer-name-async'. When operating on multiple files and COMMAND |
| 731 | ends in `&', the shell command is executed on each file in parallel. | 731 | ends in `&', the shell command is executed on each file in parallel. |
| 732 | However, when COMMAND ends in `;' or `;&' then commands are executed | 732 | However, when COMMAND ends in `;' or `;&' then commands are executed |
| 733 | in the background on each file sequentially waiting for each command | 733 | in the background on each file sequentially waiting for each command |
| @@ -735,7 +735,7 @@ to terminate before running the next command. You can also use | |||
| 735 | `dired-do-async-shell-command' that automatically adds `&'. | 735 | `dired-do-async-shell-command' that automatically adds `&'. |
| 736 | 736 | ||
| 737 | Otherwise, COMMAND is executed synchronously, and the output | 737 | Otherwise, COMMAND is executed synchronously, and the output |
| 738 | appears in the buffer `*Shell Command Output*'. | 738 | appears in the buffer `shell-command-buffer-name'. |
| 739 | 739 | ||
| 740 | This feature does not try to redisplay Dired buffers afterward, as | 740 | This feature does not try to redisplay Dired buffers afterward, as |
| 741 | there's no telling what files COMMAND may have changed. | 741 | there's no telling what files COMMAND may have changed. |
| @@ -952,13 +952,17 @@ With a prefix argument, kill that many lines starting with the current line. | |||
| 952 | "Kill all marked lines (not the files). | 952 | "Kill all marked lines (not the files). |
| 953 | With a prefix argument, kill that many lines starting with the current line. | 953 | With a prefix argument, kill that many lines starting with the current line. |
| 954 | \(A negative argument kills backward.) | 954 | \(A negative argument kills backward.) |
| 955 | |||
| 955 | If you use this command with a prefix argument to kill the line | 956 | If you use this command with a prefix argument to kill the line |
| 956 | for a file that is a directory, which you have inserted in the | 957 | for a file that is a directory, which you have inserted in the |
| 957 | Dired buffer as a subdirectory, then it deletes that subdirectory | 958 | Dired buffer as a subdirectory, then it deletes that subdirectory |
| 958 | from the buffer as well. | 959 | from the buffer as well. |
| 960 | |||
| 959 | To kill an entire subdirectory \(without killing its line in the | 961 | To kill an entire subdirectory \(without killing its line in the |
| 960 | parent directory), go to its directory header line and use this | 962 | parent directory), go to its directory header line and use this |
| 961 | command with a prefix argument (the value does not matter)." | 963 | command with a prefix argument (the value does not matter). |
| 964 | |||
| 965 | To undo the killing, the undo command can be used as normally." | ||
| 962 | ;; Returns count of killed lines. FMT="" suppresses message. | 966 | ;; Returns count of killed lines. FMT="" suppresses message. |
| 963 | (interactive "P") | 967 | (interactive "P") |
| 964 | (if arg | 968 | (if arg |
| @@ -1010,8 +1014,8 @@ command with a prefix argument (the value does not matter)." | |||
| 1010 | (defvar dired-compress-file-suffixes | 1014 | (defvar dired-compress-file-suffixes |
| 1011 | '( | 1015 | '( |
| 1012 | ;; "tar -zxf" isn't used because it's not available on the | 1016 | ;; "tar -zxf" isn't used because it's not available on the |
| 1013 | ;; Solaris10 version of tar. Solaris10 becomes obsolete in 2021. | 1017 | ;; Solaris 10 version of tar (obsolete in 2024?). |
| 1014 | ;; Same thing on AIX 7.1. | 1018 | ;; Same thing on AIX 7.1 (obsolete 2023?) and 7.2 (obsolete 2022?). |
| 1015 | ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -") | 1019 | ("\\.tar\\.gz\\'" "" "gzip -dc %i | tar -xf -") |
| 1016 | ("\\.tgz\\'" "" "gzip -dc %i | tar -xf -") | 1020 | ("\\.tgz\\'" "" "gzip -dc %i | tar -xf -") |
| 1017 | ("\\.gz\\'" "" "gunzip") | 1021 | ("\\.gz\\'" "" "gunzip") |
| @@ -1974,6 +1978,10 @@ Optional arg HOW-TO determines how to treat the target. | |||
| 1974 | (apply (car into-dir) operation rfn-list fn-list target (cdr into-dir)) | 1978 | (apply (car into-dir) operation rfn-list fn-list target (cdr into-dir)) |
| 1975 | (if (not (or dired-one-file into-dir)) | 1979 | (if (not (or dired-one-file into-dir)) |
| 1976 | (error "Marked %s: target must be a directory: %s" operation target)) | 1980 | (error "Marked %s: target must be a directory: %s" operation target)) |
| 1981 | (if (and (not (file-directory-p (car fn-list))) | ||
| 1982 | (not (file-directory-p target)) | ||
| 1983 | (directory-name-p target)) | ||
| 1984 | (error "%s: Target directory does not exist: %s" operation target)) | ||
| 1977 | ;; rename-file bombs when moving directories unless we do this: | 1985 | ;; rename-file bombs when moving directories unless we do this: |
| 1978 | (or into-dir (setq target (directory-file-name target))) | 1986 | (or into-dir (setq target (directory-file-name target))) |
| 1979 | (dired-create-files | 1987 | (dired-create-files |
diff --git a/lisp/dired.el b/lisp/dired.el index 1792250ac90..d19d6d1581d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el | |||
| @@ -125,7 +125,7 @@ For more details, see Info node `(emacs)ls in Lisp'." | |||
| 125 | "Informs Dired about how `ls -lF' marks symbolic links. | 125 | "Informs Dired about how `ls -lF' marks symbolic links. |
| 126 | Set this to t if `ls' (or whatever program is specified by | 126 | Set this to t if `ls' (or whatever program is specified by |
| 127 | `insert-directory-program') with `-lF' marks the symbolic link | 127 | `insert-directory-program') with `-lF' marks the symbolic link |
| 128 | itself with a trailing @ (usually the case under Ultrix). | 128 | itself with a trailing @ (usually the case under Ultrix and macOS). |
| 129 | 129 | ||
| 130 | Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to | 130 | Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to |
| 131 | nil (the default), if it gives `bar@ -> foo', set it to t. | 131 | nil (the default), if it gives `bar@ -> foo', set it to t. |
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index d9da36586ce..05eb0ac5693 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el | |||
| @@ -1126,7 +1126,7 @@ write its autoloads into the specified file instead." | |||
| 1126 | ;; Elements remaining in FILES have no existing autoload sections yet. | 1126 | ;; Elements remaining in FILES have no existing autoload sections yet. |
| 1127 | (let ((no-autoloads-time (or last-time '(0 0 0 0))) | 1127 | (let ((no-autoloads-time (or last-time '(0 0 0 0))) |
| 1128 | (progress (make-progress-reporter | 1128 | (progress (make-progress-reporter |
| 1129 | (byte-compile-info-string | 1129 | (byte-compile-info |
| 1130 | (concat "Scraping files for " | 1130 | (concat "Scraping files for " |
| 1131 | (file-relative-name | 1131 | (file-relative-name |
| 1132 | generated-autoload-file))) | 1132 | generated-autoload-file))) |
| @@ -1169,6 +1169,19 @@ write its autoloads into the specified file instead." | |||
| 1169 | ;; file-local autoload-generated-file settings. | 1169 | ;; file-local autoload-generated-file settings. |
| 1170 | (autoload-save-buffers)))) | 1170 | (autoload-save-buffers)))) |
| 1171 | 1171 | ||
| 1172 | (defun batch-update-autoloads--summary (strings) | ||
| 1173 | (let ((message "")) | ||
| 1174 | (while strings | ||
| 1175 | (when (> (length (concat message " " (car strings))) 64) | ||
| 1176 | (byte-compile-info (concat message " ...") t "SCRAPE") | ||
| 1177 | (setq message "")) | ||
| 1178 | (setq message (if (zerop (length message)) | ||
| 1179 | (car strings) | ||
| 1180 | (concat message " " (car strings)))) | ||
| 1181 | (setq strings (cdr strings))) | ||
| 1182 | (when (> (length message) 0) | ||
| 1183 | (byte-compile-info message t "SCRAPE")))) | ||
| 1184 | |||
| 1172 | ;;;###autoload | 1185 | ;;;###autoload |
| 1173 | (defun batch-update-autoloads () | 1186 | (defun batch-update-autoloads () |
| 1174 | "Update loaddefs.el autoloads in batch mode. | 1187 | "Update loaddefs.el autoloads in batch mode. |
| @@ -1192,6 +1205,7 @@ should be non-nil)." | |||
| 1192 | (or (string-match "\\`site-" file) | 1205 | (or (string-match "\\`site-" file) |
| 1193 | (push (expand-file-name file) autoload-excludes))))))) | 1206 | (push (expand-file-name file) autoload-excludes))))))) |
| 1194 | (let ((args command-line-args-left)) | 1207 | (let ((args command-line-args-left)) |
| 1208 | (batch-update-autoloads--summary args) | ||
| 1195 | (setq command-line-args-left nil) | 1209 | (setq command-line-args-left nil) |
| 1196 | (apply #'update-directory-autoloads args))) | 1210 | (apply #'update-directory-autoloads args))) |
| 1197 | 1211 | ||
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 0d9c449b3b4..4987596bf95 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el | |||
| @@ -648,14 +648,23 @@ | |||
| 648 | (setq args (cons (car rest) args))) | 648 | (setq args (cons (car rest) args))) |
| 649 | (setq rest (cdr rest))) | 649 | (setq rest (cdr rest))) |
| 650 | (if (cdr constants) | 650 | (if (cdr constants) |
| 651 | (if args | 651 | (let ((const (apply (car form) (nreverse constants)))) |
| 652 | (list (car form) | 652 | (if args |
| 653 | (apply (car form) constants) | 653 | (append (list (car form) const) |
| 654 | (if (cdr args) | 654 | (nreverse args)) |
| 655 | (cons (car form) (nreverse args)) | 655 | const)) |
| 656 | (car args))) | 656 | form))) |
| 657 | (apply (car form) constants)) | 657 | |
| 658 | form))) | 658 | (defun byte-optimize-min-max (form) |
| 659 | "Optimize `min' and `max'." | ||
| 660 | (let ((opt (byte-optimize-associative-math form))) | ||
| 661 | (if (and (consp opt) (memq (car opt) '(min max)) | ||
| 662 | (= (length opt) 4)) | ||
| 663 | ;; (OP x y z) -> (OP (OP x y) z), in order to use binary byte ops. | ||
| 664 | (list (car opt) | ||
| 665 | (list (car opt) (nth 1 opt) (nth 2 opt)) | ||
| 666 | (nth 3 opt)) | ||
| 667 | opt))) | ||
| 659 | 668 | ||
| 660 | ;; Use OP to reduce any leading prefix of constant numbers in the list | 669 | ;; Use OP to reduce any leading prefix of constant numbers in the list |
| 661 | ;; (cons ACCUM ARGS) down to a single number, and return the | 670 | ;; (cons ACCUM ARGS) down to a single number, and return the |
| @@ -878,8 +887,8 @@ | |||
| 878 | (put '* 'byte-optimizer #'byte-optimize-multiply) | 887 | (put '* 'byte-optimizer #'byte-optimize-multiply) |
| 879 | (put '- 'byte-optimizer #'byte-optimize-minus) | 888 | (put '- 'byte-optimizer #'byte-optimize-minus) |
| 880 | (put '/ 'byte-optimizer #'byte-optimize-divide) | 889 | (put '/ 'byte-optimizer #'byte-optimize-divide) |
| 881 | (put 'max 'byte-optimizer #'byte-optimize-associative-math) | 890 | (put 'max 'byte-optimizer #'byte-optimize-min-max) |
| 882 | (put 'min 'byte-optimizer #'byte-optimize-associative-math) | 891 | (put 'min 'byte-optimizer #'byte-optimize-min-max) |
| 883 | 892 | ||
| 884 | (put '= 'byte-optimizer #'byte-optimize-binary-predicate) | 893 | (put '= 'byte-optimizer #'byte-optimize-binary-predicate) |
| 885 | (put 'eq 'byte-optimizer #'byte-optimize-binary-predicate) | 894 | (put 'eq 'byte-optimizer #'byte-optimize-binary-predicate) |
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 539846683f0..8c16c172bed 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el | |||
| @@ -587,13 +587,26 @@ Otherwise, return nil. For internal use only." | |||
| 587 | (mapconcat (lambda (char) (format "`?\\%c'" char)) | 587 | (mapconcat (lambda (char) (format "`?\\%c'" char)) |
| 588 | sorted ", "))))) | 588 | sorted ", "))))) |
| 589 | 589 | ||
| 590 | (defun byte-compile-info (string &optional message type) | ||
| 591 | "Format STRING in a way that looks pleasing in the compilation output. | ||
| 592 | If MESSAGE, output the message, too. | ||
| 593 | |||
| 594 | If TYPE, it should be a string that says what the information | ||
| 595 | type is. This defaults to \"INFO\"." | ||
| 596 | (let ((string (format " %-9s%s" (or type "INFO") string))) | ||
| 597 | (when message | ||
| 598 | (message "%s" string)) | ||
| 599 | string)) | ||
| 600 | |||
| 590 | (defun byte-compile-info-string (&rest args) | 601 | (defun byte-compile-info-string (&rest args) |
| 591 | "Format ARGS in a way that looks pleasing in the compilation output." | 602 | "Format ARGS in a way that looks pleasing in the compilation output." |
| 592 | (format " %-9s%s" "INFO" (apply #'format args))) | 603 | (declare (obsolete byte-compile-info "28.1")) |
| 604 | (byte-compile-info (apply #'format args))) | ||
| 593 | 605 | ||
| 594 | (defun byte-compile-info-message (&rest args) | 606 | (defun byte-compile-info-message (&rest args) |
| 595 | "Message format ARGS in a way that looks pleasing in the compilation output." | 607 | "Message format ARGS in a way that looks pleasing in the compilation output." |
| 596 | (message "%s" (apply #'byte-compile-info-string args))) | 608 | (declare (obsolete byte-compile-info "28.1")) |
| 609 | (byte-compile-info (apply #'format args) t)) | ||
| 597 | 610 | ||
| 598 | 611 | ||
| 599 | ;; I nuked this because it's not a good idea for users to think of using it. | 612 | ;; I nuked this because it's not a good idea for users to think of using it. |
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7a56aa2df29..c5b086f91a0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -3659,10 +3659,10 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" | |||
| 3659 | (byte-defop-compiler (% byte-rem) 2) | 3659 | (byte-defop-compiler (% byte-rem) 2) |
| 3660 | (byte-defop-compiler aset 3) | 3660 | (byte-defop-compiler aset 3) |
| 3661 | 3661 | ||
| 3662 | (byte-defop-compiler max byte-compile-associative) | 3662 | (byte-defop-compiler max byte-compile-min-max) |
| 3663 | (byte-defop-compiler min byte-compile-associative) | 3663 | (byte-defop-compiler min byte-compile-min-max) |
| 3664 | (byte-defop-compiler (+ byte-plus) byte-compile-associative) | 3664 | (byte-defop-compiler (+ byte-plus) byte-compile-variadic-numeric) |
| 3665 | (byte-defop-compiler (* byte-mult) byte-compile-associative) | 3665 | (byte-defop-compiler (* byte-mult) byte-compile-variadic-numeric) |
| 3666 | 3666 | ||
| 3667 | ;;####(byte-defop-compiler move-to-column 1) | 3667 | ;;####(byte-defop-compiler move-to-column 1) |
| 3668 | (byte-defop-compiler-1 interactive byte-compile-noop) | 3668 | (byte-defop-compiler-1 interactive byte-compile-noop) |
| @@ -3809,30 +3809,36 @@ discarding." | |||
| 3809 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) | 3809 | (if byte-compile--for-effect (setq byte-compile--for-effect nil) |
| 3810 | (byte-compile-out 'byte-constant (nth 1 form)))) | 3810 | (byte-compile-out 'byte-constant (nth 1 form)))) |
| 3811 | 3811 | ||
| 3812 | ;; Compile a function that accepts one or more args and is right-associative. | 3812 | ;; Compile a pure function that accepts zero or more numeric arguments |
| 3813 | ;; We do it by left-associativity so that the operations | 3813 | ;; and has an opcode for the binary case. |
| 3814 | ;; are done in the same order as in interpreted code. | 3814 | ;; Single-argument calls are assumed to be numeric identity and are |
| 3815 | ;; We treat the one-arg case, as in (+ x), like (+ x 0). | 3815 | ;; compiled as (* x 1) in order to convert markers to numbers and |
| 3816 | ;; in order to convert markers to numbers, and trigger expected errors. | 3816 | ;; trigger type errors. |
| 3817 | (defun byte-compile-associative (form) | 3817 | (defun byte-compile-variadic-numeric (form) |
| 3818 | (pcase (length form) | ||
| 3819 | (1 | ||
| 3820 | ;; No args: use the identity value for the operation. | ||
| 3821 | (byte-compile-constant (eval form))) | ||
| 3822 | (2 | ||
| 3823 | ;; One arg: compile (OP x) as (* x 1). This is identity for | ||
| 3824 | ;; all numerical values including -0.0, infinities and NaNs. | ||
| 3825 | (byte-compile-form (nth 1 form)) | ||
| 3826 | (byte-compile-constant 1) | ||
| 3827 | (byte-compile-out (get '* 'byte-opcode) 0)) | ||
| 3828 | (3 | ||
| 3829 | (byte-compile-form (nth 1 form)) | ||
| 3830 | (byte-compile-form (nth 2 form)) | ||
| 3831 | (byte-compile-out (get (car form) 'byte-opcode) 0)) | ||
| 3832 | (_ | ||
| 3833 | ;; >2 args: compile as a single function call. | ||
| 3834 | (byte-compile-normal-call form)))) | ||
| 3835 | |||
| 3836 | (defun byte-compile-min-max (form) | ||
| 3837 | "Byte-compile calls to `min' or `max'." | ||
| 3818 | (if (cdr form) | 3838 | (if (cdr form) |
| 3819 | (let ((opcode (get (car form) 'byte-opcode)) | 3839 | (byte-compile-variadic-numeric form) |
| 3820 | args) | 3840 | ;; No args: warn and emit code that raises an error when executed. |
| 3821 | (if (and (< 3 (length form)) | 3841 | (byte-compile-normal-call form))) |
| 3822 | (memq opcode (list (get '+ 'byte-opcode) | ||
| 3823 | (get '* 'byte-opcode)))) | ||
| 3824 | ;; Don't use binary operations for > 2 operands, as that | ||
| 3825 | ;; may cause overflow/truncation in float operations. | ||
| 3826 | (byte-compile-normal-call form) | ||
| 3827 | (setq args (copy-sequence (cdr form))) | ||
| 3828 | (byte-compile-form (car args)) | ||
| 3829 | (setq args (cdr args)) | ||
| 3830 | (or args (setq args '(0) | ||
| 3831 | opcode (get '+ 'byte-opcode))) | ||
| 3832 | (dolist (arg args) | ||
| 3833 | (byte-compile-form arg) | ||
| 3834 | (byte-compile-out opcode 0)))) | ||
| 3835 | (byte-compile-constant (eval form)))) | ||
| 3836 | 3842 | ||
| 3837 | 3843 | ||
| 3838 | ;; more complicated compiler macros | 3844 | ;; more complicated compiler macros |
| @@ -3847,7 +3853,7 @@ discarding." | |||
| 3847 | (byte-defop-compiler indent-to) | 3853 | (byte-defop-compiler indent-to) |
| 3848 | (byte-defop-compiler insert) | 3854 | (byte-defop-compiler insert) |
| 3849 | (byte-defop-compiler-1 function byte-compile-function-form) | 3855 | (byte-defop-compiler-1 function byte-compile-function-form) |
| 3850 | (byte-defop-compiler-1 - byte-compile-minus) | 3856 | (byte-defop-compiler (- byte-diff) byte-compile-minus) |
| 3851 | (byte-defop-compiler (/ byte-quo) byte-compile-quo) | 3857 | (byte-defop-compiler (/ byte-quo) byte-compile-quo) |
| 3852 | (byte-defop-compiler nconc) | 3858 | (byte-defop-compiler nconc) |
| 3853 | 3859 | ||
| @@ -3914,30 +3920,17 @@ discarding." | |||
| 3914 | ((byte-compile-normal-call form))))) | 3920 | ((byte-compile-normal-call form))))) |
| 3915 | 3921 | ||
| 3916 | (defun byte-compile-minus (form) | 3922 | (defun byte-compile-minus (form) |
| 3917 | (let ((len (length form))) | 3923 | (if (/= (length form) 2) |
| 3918 | (cond | 3924 | (byte-compile-variadic-numeric form) |
| 3919 | ((= 1 len) (byte-compile-constant 0)) | 3925 | (byte-compile-form (cadr form)) |
| 3920 | ((= 2 len) | 3926 | (byte-compile-out 'byte-negate 0))) |
| 3921 | (byte-compile-form (cadr form)) | ||
| 3922 | (byte-compile-out 'byte-negate 0)) | ||
| 3923 | ((= 3 len) | ||
| 3924 | (byte-compile-form (nth 1 form)) | ||
| 3925 | (byte-compile-form (nth 2 form)) | ||
| 3926 | (byte-compile-out 'byte-diff 0)) | ||
| 3927 | ;; Don't use binary operations for > 2 operands, as that may | ||
| 3928 | ;; cause overflow/truncation in float operations. | ||
| 3929 | (t (byte-compile-normal-call form))))) | ||
| 3930 | 3927 | ||
| 3931 | (defun byte-compile-quo (form) | 3928 | (defun byte-compile-quo (form) |
| 3932 | (let ((len (length form))) | 3929 | (if (= (length form) 3) |
| 3933 | (cond ((< len 2) | 3930 | (byte-compile-two-args form) |
| 3934 | (byte-compile-subr-wrong-args form "1 or more")) | 3931 | ;; N-ary `/' is not the left-reduction of binary `/' because if any |
| 3935 | ((= len 3) | 3932 | ;; argument is a float, then everything is done in floating-point. |
| 3936 | (byte-compile-two-args form)) | 3933 | (byte-compile-normal-call form))) |
| 3937 | (t | ||
| 3938 | ;; Don't use binary operations for > 2 operands, as that | ||
| 3939 | ;; may cause overflow/truncation in float operations. | ||
| 3940 | (byte-compile-normal-call form))))) | ||
| 3941 | 3934 | ||
| 3942 | (defun byte-compile-nconc (form) | 3935 | (defun byte-compile-nconc (form) |
| 3943 | (let ((len (length form))) | 3936 | (let ((len (length form))) |
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 4e8423eb5b1..02da07daaf4 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el | |||
| @@ -211,7 +211,16 @@ DEFAULT-BODY, if present, is used as the body of a default method. | |||
| 211 | [&rest [&or | 211 | [&rest [&or |
| 212 | ("declare" &rest sexp) | 212 | ("declare" &rest sexp) |
| 213 | (":argument-precedence-order" &rest sexp) | 213 | (":argument-precedence-order" &rest sexp) |
| 214 | (&define ":method" [&rest atom] | 214 | (&define ":method" |
| 215 | ;; FIXME: The `:unique' | ||
| 216 | ;; construct works around | ||
| 217 | ;; Bug#42672. We'd rather want | ||
| 218 | ;; names like those generated by | ||
| 219 | ;; `cl-defmethod', but that | ||
| 220 | ;; requires larger changes to | ||
| 221 | ;; Edebug. | ||
| 222 | :unique "cl-generic-:method@" | ||
| 223 | [&rest cl-generic-method-qualifier] | ||
| 215 | cl-generic-method-args lambda-doc | 224 | cl-generic-method-args lambda-doc |
| 216 | def-body)]] | 225 | def-body)]] |
| 217 | def-body))) | 226 | def-body))) |
| @@ -432,9 +441,8 @@ The set of acceptable TYPEs (also called \"specializers\") is defined | |||
| 432 | (&define ; this means we are defining something | 441 | (&define ; this means we are defining something |
| 433 | [&or name ("setf" name :name setf)] | 442 | [&or name ("setf" name :name setf)] |
| 434 | ;; ^^ This is the methods symbol | 443 | ;; ^^ This is the methods symbol |
| 435 | [ &rest atom ] ; Multiple qualifiers are allowed. | 444 | [ &rest cl-generic-method-qualifier ] |
| 436 | ; Like in CLOS spec, we support | 445 | ;; Multiple qualifiers are allowed. |
| 437 | ; any non-list values. | ||
| 438 | cl-generic-method-args ; arguments | 446 | cl-generic-method-args ; arguments |
| 439 | lambda-doc ; documentation string | 447 | lambda-doc ; documentation string |
| 440 | def-body))) ; part to be debugged | 448 | def-body))) ; part to be debugged |
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 6c1426ce5cb..c38019d4a73 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el | |||
| @@ -2016,7 +2016,12 @@ info node `(cl) Function Bindings' for details. | |||
| 2016 | 2016 | ||
| 2017 | \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" | 2017 | \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" |
| 2018 | (declare (indent 1) | 2018 | (declare (indent 1) |
| 2019 | (debug ((&rest [&or (&define name function-form) (cl-defun)]) | 2019 | (debug ((&rest [&or (&define name :unique "cl-flet@" function-form) |
| 2020 | (&define name :unique "cl-flet@" | ||
| 2021 | cl-lambda-list | ||
| 2022 | cl-declarations-or-string | ||
| 2023 | [&optional ("interactive" interactive)] | ||
| 2024 | def-body)]) | ||
| 2020 | cl-declarations body))) | 2025 | cl-declarations body))) |
| 2021 | (let ((binds ()) (newenv macroexpand-all-environment)) | 2026 | (let ((binds ()) (newenv macroexpand-all-environment)) |
| 2022 | (dolist (binding bindings) | 2027 | (dolist (binding bindings) |
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index a565e8f6dcb..d9bbf6129c6 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el | |||
| @@ -1240,6 +1240,13 @@ purpose by adding an entry to this alist, and setting | |||
| 1240 | ;; since it wraps the list of forms with a call to `edebug-enter'. | 1240 | ;; since it wraps the list of forms with a call to `edebug-enter'. |
| 1241 | ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. | 1241 | ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args. |
| 1242 | ;; Do this after parsing since that may find a name. | 1242 | ;; Do this after parsing since that may find a name. |
| 1243 | (when (string-match-p (rx bos "edebug-anon" (+ digit) eos) | ||
| 1244 | (symbol-name edebug-old-def-name)) | ||
| 1245 | ;; FIXME: Due to Bug#42701, we reset an anonymous name so that | ||
| 1246 | ;; backtracking doesn't generate duplicate definitions. It would | ||
| 1247 | ;; be better to not define wrappers in the case of a non-matching | ||
| 1248 | ;; specification branch to begin with. | ||
| 1249 | (setq edebug-old-def-name nil)) | ||
| 1243 | (setq edebug-def-name | 1250 | (setq edebug-def-name |
| 1244 | (or edebug-def-name edebug-old-def-name (gensym "edebug-anon"))) | 1251 | (or edebug-def-name edebug-old-def-name (gensym "edebug-anon"))) |
| 1245 | `(edebug-enter | 1252 | `(edebug-enter |
| @@ -1725,12 +1732,15 @@ contains a circular object." | |||
| 1725 | (&define . edebug-match-&define) | 1732 | (&define . edebug-match-&define) |
| 1726 | (name . edebug-match-name) | 1733 | (name . edebug-match-name) |
| 1727 | (:name . edebug-match-colon-name) | 1734 | (:name . edebug-match-colon-name) |
| 1735 | (:unique . edebug-match-:unique) | ||
| 1728 | (arg . edebug-match-arg) | 1736 | (arg . edebug-match-arg) |
| 1729 | (def-body . edebug-match-def-body) | 1737 | (def-body . edebug-match-def-body) |
| 1730 | (def-form . edebug-match-def-form) | 1738 | (def-form . edebug-match-def-form) |
| 1731 | ;; Less frequently used: | 1739 | ;; Less frequently used: |
| 1732 | ;; (function . edebug-match-function) | 1740 | ;; (function . edebug-match-function) |
| 1733 | (lambda-expr . edebug-match-lambda-expr) | 1741 | (lambda-expr . edebug-match-lambda-expr) |
| 1742 | (cl-generic-method-qualifier | ||
| 1743 | . edebug-match-cl-generic-method-qualifier) | ||
| 1734 | (cl-generic-method-args . edebug-match-cl-generic-method-args) | 1744 | (cl-generic-method-args . edebug-match-cl-generic-method-args) |
| 1735 | (cl-macrolet-expr . edebug-match-cl-macrolet-expr) | 1745 | (cl-macrolet-expr . edebug-match-cl-macrolet-expr) |
| 1736 | (cl-macrolet-name . edebug-match-cl-macrolet-name) | 1746 | (cl-macrolet-name . edebug-match-cl-macrolet-name) |
| @@ -2035,6 +2045,27 @@ contains a circular object." | |||
| 2035 | spec)) | 2045 | spec)) |
| 2036 | nil) | 2046 | nil) |
| 2037 | 2047 | ||
| 2048 | (defun edebug-match-:unique (_cursor spec) | ||
| 2049 | "Match a `:unique PREFIX' specifier. | ||
| 2050 | SPEC is the symbol name prefix for `gensym'." | ||
| 2051 | (let ((suffix (gensym spec))) | ||
| 2052 | (setq edebug-def-name | ||
| 2053 | (if edebug-def-name | ||
| 2054 | ;; Construct a new name by appending to previous name. | ||
| 2055 | (intern (format "%s@%s" edebug-def-name suffix)) | ||
| 2056 | suffix))) | ||
| 2057 | nil) | ||
| 2058 | |||
| 2059 | (defun edebug-match-cl-generic-method-qualifier (cursor) | ||
| 2060 | "Match a QUALIFIER for `cl-defmethod' at CURSOR." | ||
| 2061 | (let ((args (edebug-top-element-required cursor "Expected qualifier"))) | ||
| 2062 | ;; Like in CLOS spec, we support any non-list values. | ||
| 2063 | (unless (atom args) (edebug-no-match cursor "Atom expected")) | ||
| 2064 | ;; Append the arguments to `edebug-def-name' (Bug#42671). | ||
| 2065 | (setq edebug-def-name (intern (format "%s %s" edebug-def-name args))) | ||
| 2066 | (edebug-move-cursor cursor) | ||
| 2067 | (list args))) | ||
| 2068 | |||
| 2038 | (defun edebug-match-cl-generic-method-args (cursor) | 2069 | (defun edebug-match-cl-generic-method-args (cursor) |
| 2039 | (let ((args (edebug-top-element-required cursor "Expected arguments"))) | 2070 | (let ((args (edebug-top-element-required cursor "Expected arguments"))) |
| 2040 | (if (not (consp args)) | 2071 | (if (not (consp args)) |
diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el new file mode 100644 index 00000000000..8cef029c4cf --- /dev/null +++ b/lisp/emacs-lisp/hierarchy.el | |||
| @@ -0,0 +1,579 @@ | |||
| 1 | ;;; hierarchy.el --- Library to create and display hierarchy structures -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Damien Cassou <damien@cassou.me> | ||
| 6 | ;; Maintainer: emacs-devel@gnu.org | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | ;; Library to create, query, navigate and display hierarchy structures. | ||
| 26 | |||
| 27 | ;; Creation: After having created a hierarchy with `hierarchy-new', | ||
| 28 | ;; populate it by calling `hierarchy-add-tree' or | ||
| 29 | ;; `hierarchy-add-trees'. You can then optionally sort its element | ||
| 30 | ;; with `hierarchy-sort'. | ||
| 31 | |||
| 32 | ;; Querying: You can learn more about your hierarchy by using | ||
| 33 | ;; functions such as `hierarchy-roots', `hierarchy-has-item', | ||
| 34 | ;; `hierarchy-length', `hierarchy-parent', `hierarchy-descendant-p'. | ||
| 35 | |||
| 36 | ;; Navigation: When your hierarchy is ready, you can use | ||
| 37 | ;; `hierarchy-map-item', `hierarchy-map', and `map-tree' to apply | ||
| 38 | ;; functions to elements of the hierarchy. | ||
| 39 | |||
| 40 | ;; Display: You can display a hierarchy as a tabulated list using | ||
| 41 | ;; `hierarchy-tabulated-display' and as an expandable/foldable tree | ||
| 42 | ;; using `hierarchy-convert-to-tree-widget'. The | ||
| 43 | ;; `hierarchy-labelfn-*' functions will help you display each item of | ||
| 44 | ;; the hierarchy the way you want it. | ||
| 45 | |||
| 46 | ;;; Limitation: | ||
| 47 | |||
| 48 | ;; - Current implementation uses #'equal to find and distinguish | ||
| 49 | ;; elements. Support for user-provided equality definition is | ||
| 50 | ;; desired but not yet implemented; | ||
| 51 | ;; | ||
| 52 | ;; - nil can't be added to a hierarchy; | ||
| 53 | ;; | ||
| 54 | ;; - the hierarchy is computed eagerly. | ||
| 55 | |||
| 56 | ;;; Code: | ||
| 57 | |||
| 58 | (require 'seq) | ||
| 59 | (require 'map) | ||
| 60 | (require 'subr-x) | ||
| 61 | (require 'cl-lib) | ||
| 62 | |||
| 63 | |||
| 64 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 65 | ;; Helpers | ||
| 66 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 67 | |||
| 68 | (cl-defstruct (hierarchy | ||
| 69 | (:constructor hierarchy--make) | ||
| 70 | (:conc-name hierarchy--)) | ||
| 71 | (roots (list)) ; list of the hierarchy roots (no parent) | ||
| 72 | (parents (make-hash-table :test 'equal)) ; map an item to its parent | ||
| 73 | (children (make-hash-table :test 'equal)) ; map an item to its childre | ||
| 74 | ;; cache containing the set of all items in the hierarchy | ||
| 75 | (seen-items (make-hash-table :test 'equal))) ; map an item to t | ||
| 76 | |||
| 77 | (defun hierarchy--seen-items-add (hierarchy item) | ||
| 78 | "In HIERARCHY, add ITEM to seen items." | ||
| 79 | (map-put! (hierarchy--seen-items hierarchy) item t)) | ||
| 80 | |||
| 81 | (defun hierarchy--compute-roots (hierarchy) | ||
| 82 | "Search roots of HIERARCHY and return them." | ||
| 83 | (cl-set-difference | ||
| 84 | (map-keys (hierarchy--seen-items hierarchy)) | ||
| 85 | (map-keys (hierarchy--parents hierarchy)) | ||
| 86 | :test #'equal)) | ||
| 87 | |||
| 88 | (defun hierarchy--sort-roots (hierarchy sortfn) | ||
| 89 | "Compute, sort and store the roots of HIERARCHY. | ||
| 90 | |||
| 91 | SORTFN is a function taking two items of the hierarchy as parameter and | ||
| 92 | returning non-nil if the first parameter is lower than the second." | ||
| 93 | (setf (hierarchy--roots hierarchy) | ||
| 94 | (sort (hierarchy--compute-roots hierarchy) | ||
| 95 | sortfn))) | ||
| 96 | |||
| 97 | (defun hierarchy--add-relation (hierarchy item parent acceptfn) | ||
| 98 | "In HIERARCHY, add ITEM as child of PARENT. | ||
| 99 | |||
| 100 | ACCEPTFN is a function returning non-nil if its parameter (any object) | ||
| 101 | should be an item of the hierarchy." | ||
| 102 | (let* ((existing-parent (hierarchy-parent hierarchy item)) | ||
| 103 | (has-parent-p (funcall acceptfn existing-parent))) | ||
| 104 | (cond | ||
| 105 | ((and has-parent-p (not (equal existing-parent parent))) | ||
| 106 | (error "An item (%s) can only have one parent: '%s' vs '%s'" | ||
| 107 | item existing-parent parent)) | ||
| 108 | ((not has-parent-p) | ||
| 109 | (let ((existing-children (map-elt (hierarchy--children hierarchy) | ||
| 110 | parent (list)))) | ||
| 111 | (map-put! (hierarchy--children hierarchy) | ||
| 112 | parent (append existing-children (list item)))) | ||
| 113 | (map-put! (hierarchy--parents hierarchy) item parent))))) | ||
| 114 | |||
| 115 | (defun hierarchy--set-equal (list1 list2 &rest cl-keys) | ||
| 116 | "Return non-nil if LIST1 and LIST2 have same elements. | ||
| 117 | |||
| 118 | I.e., if every element of LIST1 also appears in LIST2 and if | ||
| 119 | every element of LIST2 also appears in LIST1. | ||
| 120 | |||
| 121 | CL-KEYS are key-value pairs just like in `cl-subsetp'. Supported | ||
| 122 | keys are :key and :test." | ||
| 123 | (and (apply 'cl-subsetp list1 list2 cl-keys) | ||
| 124 | (apply 'cl-subsetp list2 list1 cl-keys))) | ||
| 125 | |||
| 126 | |||
| 127 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 128 | ;; Creation | ||
| 129 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 130 | |||
| 131 | (defun hierarchy-new () | ||
| 132 | "Create a hierarchy and return it." | ||
| 133 | (hierarchy--make)) | ||
| 134 | |||
| 135 | (defun hierarchy-add-tree (hierarchy item parentfn &optional childrenfn acceptfn) | ||
| 136 | "In HIERARCHY, add ITEM. | ||
| 137 | |||
| 138 | PARENTFN is either nil or a function defining the child-to-parent | ||
| 139 | relationship: this function takes an item as parameter and should return | ||
| 140 | the parent of this item in the hierarchy. If the item has no parent in the | ||
| 141 | hierarchy (i.e., it should be a root), the function should return an object | ||
| 142 | not accepted by acceptfn (i.e., nil for the default value of acceptfn). | ||
| 143 | |||
| 144 | CHILDRENFN is either nil or a function defining the parent-to-children | ||
| 145 | relationship: this function takes an item as parameter and should return a | ||
| 146 | list of children of this item in the hierarchy. | ||
| 147 | |||
| 148 | If both PARENTFN and CHILDRENFN are non-nil, the results of PARENTFN and | ||
| 149 | CHILDRENFN are expected to be coherent with each other. | ||
| 150 | |||
| 151 | ACCEPTFN is a function returning non-nil if its parameter (any object) | ||
| 152 | should be an item of the hierarchy. By default, ACCEPTFN returns non-nil | ||
| 153 | if its parameter is non-nil." | ||
| 154 | (unless (hierarchy-has-item hierarchy item) | ||
| 155 | (let ((acceptfn (or acceptfn #'identity))) | ||
| 156 | (hierarchy--seen-items-add hierarchy item) | ||
| 157 | (let ((parent (and parentfn (funcall parentfn item)))) | ||
| 158 | (when (funcall acceptfn parent) | ||
| 159 | (hierarchy--add-relation hierarchy item parent acceptfn) | ||
| 160 | (hierarchy-add-tree hierarchy parent parentfn childrenfn))) | ||
| 161 | (let ((children (and childrenfn (funcall childrenfn item)))) | ||
| 162 | (mapc (lambda (child) | ||
| 163 | (when (funcall acceptfn child) | ||
| 164 | (hierarchy--add-relation hierarchy child item acceptfn) | ||
| 165 | (hierarchy-add-tree hierarchy child parentfn childrenfn))) | ||
| 166 | children))))) | ||
| 167 | |||
| 168 | (defun hierarchy-add-trees (hierarchy items parentfn &optional childrenfn acceptfn) | ||
| 169 | "Call `hierarchy-add-tree' on HIERARCHY and each element of ITEMS. | ||
| 170 | |||
| 171 | PARENTFN, CHILDRENFN and ACCEPTFN have the same meaning as in `hierarchy-add'." | ||
| 172 | (seq-map (lambda (item) | ||
| 173 | (hierarchy-add-tree hierarchy item parentfn childrenfn acceptfn)) | ||
| 174 | items)) | ||
| 175 | |||
| 176 | (defun hierarchy-add-list (hierarchy list &optional wrap childrenfn) | ||
| 177 | "Add to HIERARCHY the sub-lists in LIST. | ||
| 178 | |||
| 179 | If WRAP is non-nil, allow duplicate items in LIST by wraping each | ||
| 180 | item in a cons (id . item). The root's id is 1. | ||
| 181 | |||
| 182 | CHILDRENFN is a function (defaults to `cdr') taking LIST as a | ||
| 183 | parameter which should return LIST's children (a list). Each | ||
| 184 | child is (recursively) passed as a parameter to CHILDRENFN to get | ||
| 185 | its own children. Because of this parameter, LIST can be | ||
| 186 | anything, not necessarily a list." | ||
| 187 | (let* ((childrenfn (or childrenfn #'cdr)) | ||
| 188 | (id 0) | ||
| 189 | (wrapfn (lambda (item) | ||
| 190 | (if wrap | ||
| 191 | (cons (setq id (1+ id)) item) | ||
| 192 | item))) | ||
| 193 | (unwrapfn (if wrap #'cdr #'identity))) | ||
| 194 | (hierarchy-add-tree | ||
| 195 | hierarchy (funcall wrapfn list) nil | ||
| 196 | (lambda (item) | ||
| 197 | (mapcar wrapfn (funcall childrenfn | ||
| 198 | (funcall unwrapfn item))))) | ||
| 199 | hierarchy)) | ||
| 200 | |||
| 201 | (defun hierarchy-from-list (list &optional wrap childrenfn) | ||
| 202 | "Create and return a hierarchy built from LIST. | ||
| 203 | |||
| 204 | This function passes LIST, WRAP and CHILDRENFN unchanged to | ||
| 205 | `hierarchy-add-list'." | ||
| 206 | (hierarchy-add-list (hierarchy-new) list wrap childrenfn)) | ||
| 207 | |||
| 208 | (defun hierarchy-sort (hierarchy &optional sortfn) | ||
| 209 | "Modify HIERARCHY so that its roots and item's children are sorted. | ||
| 210 | |||
| 211 | SORTFN is a function taking two items of the hierarchy as parameter and | ||
| 212 | returning non-nil if the first parameter is lower than the second. By | ||
| 213 | default, SORTFN is `string-lessp'." | ||
| 214 | (let ((sortfn (or sortfn #'string-lessp))) | ||
| 215 | (hierarchy--sort-roots hierarchy sortfn) | ||
| 216 | (mapc (lambda (parent) | ||
| 217 | (setf | ||
| 218 | (map-elt (hierarchy--children hierarchy) parent) | ||
| 219 | (sort (map-elt (hierarchy--children hierarchy) parent) sortfn))) | ||
| 220 | (map-keys (hierarchy--children hierarchy))))) | ||
| 221 | |||
| 222 | (defun hierarchy-extract-tree (hierarchy item) | ||
| 223 | "Return a copy of HIERARCHY with ITEM's descendants and parents." | ||
| 224 | (if (not (hierarchy-has-item hierarchy item)) | ||
| 225 | nil | ||
| 226 | (let ((tree (hierarchy-new))) | ||
| 227 | (hierarchy-add-tree tree item | ||
| 228 | (lambda (each) (hierarchy-parent hierarchy each)) | ||
| 229 | (lambda (each) | ||
| 230 | (when (or (equal each item) | ||
| 231 | (hierarchy-descendant-p hierarchy each item)) | ||
| 232 | (hierarchy-children hierarchy each)))) | ||
| 233 | tree))) | ||
| 234 | |||
| 235 | (defun hierarchy-copy (hierarchy) | ||
| 236 | "Return a copy of HIERARCHY. | ||
| 237 | |||
| 238 | Items in HIERARCHY are shared, but structure is not." | ||
| 239 | (hierarchy-map-hierarchy (lambda (item _) (identity item)) hierarchy)) | ||
| 240 | |||
| 241 | |||
| 242 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 243 | ;; Querying | ||
| 244 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 245 | |||
| 246 | (defun hierarchy-items (hierarchy) | ||
| 247 | "Return a list of all items of HIERARCHY." | ||
| 248 | (map-keys (hierarchy--seen-items hierarchy))) | ||
| 249 | |||
| 250 | (defun hierarchy-has-item (hierarchy item) | ||
| 251 | "Return t if HIERARCHY includes ITEM." | ||
| 252 | (map-contains-key (hierarchy--seen-items hierarchy) item)) | ||
| 253 | |||
| 254 | (defun hierarchy-empty-p (hierarchy) | ||
| 255 | "Return t if HIERARCHY is empty." | ||
| 256 | (= 0 (hierarchy-length hierarchy))) | ||
| 257 | |||
| 258 | (defun hierarchy-length (hierarchy) | ||
| 259 | "Return the number of items in HIERARCHY." | ||
| 260 | (hash-table-count (hierarchy--seen-items hierarchy))) | ||
| 261 | |||
| 262 | (defun hierarchy-has-root (hierarchy item) | ||
| 263 | "Return t if one of HIERARCHY's roots is ITEM. | ||
| 264 | |||
| 265 | A root is an item with no parent." | ||
| 266 | (seq-contains-p (hierarchy-roots hierarchy) item)) | ||
| 267 | |||
| 268 | (defun hierarchy-roots (hierarchy) | ||
| 269 | "Return all roots of HIERARCHY. | ||
| 270 | |||
| 271 | A root is an item with no parent." | ||
| 272 | (let ((roots (hierarchy--roots hierarchy))) | ||
| 273 | (or roots | ||
| 274 | (hierarchy--compute-roots hierarchy)))) | ||
| 275 | |||
| 276 | (defun hierarchy-leafs (hierarchy &optional node) | ||
| 277 | "Return all leafs of HIERARCHY. | ||
| 278 | |||
| 279 | A leaf is an item with no child. | ||
| 280 | |||
| 281 | If NODE is an item of HIERARCHY, only return leafs under NODE." | ||
| 282 | (let ((leafs (cl-set-difference | ||
| 283 | (map-keys (hierarchy--seen-items hierarchy)) | ||
| 284 | (map-keys (hierarchy--children hierarchy))))) | ||
| 285 | (if (hierarchy-has-item hierarchy node) | ||
| 286 | (seq-filter (lambda (item) | ||
| 287 | (hierarchy-descendant-p hierarchy item node)) | ||
| 288 | leafs) | ||
| 289 | leafs))) | ||
| 290 | |||
| 291 | (defun hierarchy-parent (hierarchy item) | ||
| 292 | "In HIERARCHY, return parent of ITEM." | ||
| 293 | (map-elt (hierarchy--parents hierarchy) item)) | ||
| 294 | |||
| 295 | (defun hierarchy-children (hierarchy parent) | ||
| 296 | "In HIERARCHY, return children of PARENT." | ||
| 297 | (map-elt (hierarchy--children hierarchy) parent (list))) | ||
| 298 | |||
| 299 | (defun hierarchy-child-p (hierarchy item1 item2) | ||
| 300 | "In HIERARCHY, return non-nil if and only if ITEM1 is a child of ITEM2." | ||
| 301 | (equal (hierarchy-parent hierarchy item1) item2)) | ||
| 302 | |||
| 303 | (defun hierarchy-descendant-p (hierarchy item1 item2) | ||
| 304 | "In HIERARCHY, return non-nil if and only if ITEM1 is a descendant of ITEM2. | ||
| 305 | |||
| 306 | ITEM1 is a descendant of ITEM2 if and only if both are items of HIERARCHY | ||
| 307 | and either: | ||
| 308 | |||
| 309 | - ITEM1 is child of ITEM2, or | ||
| 310 | - ITEM1's parent is a descendant of ITEM2." | ||
| 311 | (and | ||
| 312 | (hierarchy-has-item hierarchy item1) | ||
| 313 | (hierarchy-has-item hierarchy item2) | ||
| 314 | (or | ||
| 315 | (hierarchy-child-p hierarchy item1 item2) | ||
| 316 | (hierarchy-descendant-p | ||
| 317 | hierarchy (hierarchy-parent hierarchy item1) item2)))) | ||
| 318 | |||
| 319 | (defun hierarchy-equal (hierarchy1 hierarchy2) | ||
| 320 | "Return t if HIERARCHY1 and HIERARCHY2 are equal. | ||
| 321 | |||
| 322 | Two equal hierarchies share the same items and the same | ||
| 323 | relationships among them." | ||
| 324 | (and (hierarchy-p hierarchy1) | ||
| 325 | (hierarchy-p hierarchy2) | ||
| 326 | (= (hierarchy-length hierarchy1) (hierarchy-length hierarchy2)) | ||
| 327 | ;; parents are the same | ||
| 328 | (seq-every-p (lambda (child) | ||
| 329 | (equal (hierarchy-parent hierarchy1 child) | ||
| 330 | (hierarchy-parent hierarchy2 child))) | ||
| 331 | (map-keys (hierarchy--parents hierarchy1))) | ||
| 332 | ;; children are the same | ||
| 333 | (seq-every-p (lambda (parent) | ||
| 334 | (hierarchy--set-equal | ||
| 335 | (hierarchy-children hierarchy1 parent) | ||
| 336 | (hierarchy-children hierarchy2 parent) | ||
| 337 | :test #'equal)) | ||
| 338 | (map-keys (hierarchy--children hierarchy1))))) | ||
| 339 | |||
| 340 | |||
| 341 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 342 | ;; Navigation | ||
| 343 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 344 | |||
| 345 | (defun hierarchy-map-item (func item hierarchy &optional indent) | ||
| 346 | "Return the result of applying FUNC to ITEM and its descendants in HIERARCHY. | ||
| 347 | |||
| 348 | This function navigates the tree top-down: FUNCTION is first called on item | ||
| 349 | and then on each of its children. Results are concatenated in a list. | ||
| 350 | |||
| 351 | INDENT is a number (default 0) representing the indentation of ITEM in | ||
| 352 | HIERARCHY. FUNC should take 2 argument: the item and its indentation | ||
| 353 | level." | ||
| 354 | (let ((indent (or indent 0))) | ||
| 355 | (cons | ||
| 356 | (funcall func item indent) | ||
| 357 | (seq-mapcat (lambda (child) (hierarchy-map-item func child | ||
| 358 | hierarchy (1+ indent))) | ||
| 359 | (hierarchy-children hierarchy item))))) | ||
| 360 | |||
| 361 | (defun hierarchy-map (func hierarchy &optional indent) | ||
| 362 | "Return the result of applying FUNC to each element of HIERARCHY. | ||
| 363 | |||
| 364 | This function navigates the tree top-down: FUNCTION is first called on each | ||
| 365 | root. To do so, it calls `hierarchy-map-item' on each root | ||
| 366 | sequentially. Results are concatenated in a list. | ||
| 367 | |||
| 368 | FUNC should take 2 arguments: the item and its indentation level. | ||
| 369 | |||
| 370 | INDENT is a number (default 0) representing the indentation of HIERARCHY's | ||
| 371 | roots." | ||
| 372 | (let ((indent (or indent 0))) | ||
| 373 | (seq-mapcat (lambda (root) (hierarchy-map-item func root hierarchy indent)) | ||
| 374 | (hierarchy-roots hierarchy)))) | ||
| 375 | |||
| 376 | (defun hierarchy-map-tree (function hierarchy &optional item indent) | ||
| 377 | "Apply FUNCTION on each item of HIERARCHY under ITEM. | ||
| 378 | |||
| 379 | This function navigates the tree bottom-up: FUNCTION is first called on | ||
| 380 | leafs and the result is passed as parameter when calling FUNCTION on | ||
| 381 | parents. | ||
| 382 | |||
| 383 | FUNCTION should take 3 parameters: the current item, its indentation | ||
| 384 | level (a number), and a list representing the result of applying | ||
| 385 | `hierarchy-map-tree' to each child of the item. | ||
| 386 | |||
| 387 | INDENT is 0 by default and is passed as second parameter to FUNCTION. | ||
| 388 | INDENT is incremented by 1 at each level of the tree. | ||
| 389 | |||
| 390 | This function returns the result of applying FUNCTION to ITEM (the first | ||
| 391 | root if nil)." | ||
| 392 | (let ((item (or item (car (hierarchy-roots hierarchy)))) | ||
| 393 | (indent (or indent 0))) | ||
| 394 | (funcall function item indent | ||
| 395 | (mapcar (lambda (child) | ||
| 396 | (hierarchy-map-tree function hierarchy | ||
| 397 | child (1+ indent))) | ||
| 398 | (hierarchy-children hierarchy item))))) | ||
| 399 | |||
| 400 | (defun hierarchy-map-hierarchy (function hierarchy) | ||
| 401 | "Apply FUNCTION to each item of HIERARCHY in a new hierarchy. | ||
| 402 | |||
| 403 | FUNCTION should take 2 parameters, the current item and its | ||
| 404 | indentation level (a number), and should return an item to be | ||
| 405 | added to the new hierarchy." | ||
| 406 | (let* ((items (make-hash-table :test #'equal)) | ||
| 407 | (transform (lambda (item) (map-elt items item)))) | ||
| 408 | ;; Make 'items', a table mapping original items to their | ||
| 409 | ;; transformation | ||
| 410 | (hierarchy-map (lambda (item indent) | ||
| 411 | (map-put! items item (funcall function item indent))) | ||
| 412 | hierarchy) | ||
| 413 | (hierarchy--make | ||
| 414 | :roots (mapcar transform (hierarchy-roots hierarchy)) | ||
| 415 | :parents (let ((result (make-hash-table :test #'equal))) | ||
| 416 | (map-apply (lambda (child parent) | ||
| 417 | (map-put! result | ||
| 418 | (funcall transform child) | ||
| 419 | (funcall transform parent))) | ||
| 420 | (hierarchy--parents hierarchy)) | ||
| 421 | result) | ||
| 422 | :children (let ((result (make-hash-table :test #'equal))) | ||
| 423 | (map-apply (lambda (parent children) | ||
| 424 | (map-put! result | ||
| 425 | (funcall transform parent) | ||
| 426 | (seq-map transform children))) | ||
| 427 | (hierarchy--children hierarchy)) | ||
| 428 | result) | ||
| 429 | :seen-items (let ((result (make-hash-table :test #'equal))) | ||
| 430 | (map-apply (lambda (item v) | ||
| 431 | (map-put! result | ||
| 432 | (funcall transform item) | ||
| 433 | v)) | ||
| 434 | (hierarchy--seen-items hierarchy)) | ||
| 435 | result)))) | ||
| 436 | |||
| 437 | |||
| 438 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 439 | ;; Display | ||
| 440 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | ||
| 441 | |||
| 442 | (defun hierarchy-labelfn-indent (labelfn &optional indent-string) | ||
| 443 | "Return a function rendering LABELFN indented with INDENT-STRING. | ||
| 444 | |||
| 445 | INDENT-STRING defaults to a 2-space string. Indentation is | ||
| 446 | multiplied by the depth of the displayed item." | ||
| 447 | (let ((indent-string (or indent-string " "))) | ||
| 448 | (lambda (item indent) | ||
| 449 | (dotimes (_ indent) (insert indent-string)) | ||
| 450 | (funcall labelfn item indent)))) | ||
| 451 | |||
| 452 | (defun hierarchy-labelfn-button (labelfn actionfn) | ||
| 453 | "Return a function rendering LABELFN in a button. | ||
| 454 | |||
| 455 | Clicking the button triggers ACTIONFN. ACTIONFN is a function | ||
| 456 | taking an item of HIERARCHY and an indentation value (a number) | ||
| 457 | as input. This function is called when an item is clicked. The | ||
| 458 | return value of ACTIONFN is ignored." | ||
| 459 | (lambda (item indent) | ||
| 460 | (let ((start (point))) | ||
| 461 | (funcall labelfn item indent) | ||
| 462 | (make-text-button start (point) | ||
| 463 | 'action (lambda (_) (funcall actionfn item indent)))))) | ||
| 464 | |||
| 465 | (defun hierarchy-labelfn-button-if (labelfn buttonp actionfn) | ||
| 466 | "Return a function rendering LABELFN as a button if BUTTONP. | ||
| 467 | |||
| 468 | Pass LABELFN and ACTIONFN to `hierarchy-labelfn-button' if | ||
| 469 | BUTTONP is non-nil. Otherwise, render LABELFN without making it | ||
| 470 | a button. | ||
| 471 | |||
| 472 | BUTTONP is a function taking an item of HIERARCHY and an | ||
| 473 | indentation value (a number) as input." | ||
| 474 | (lambda (item indent) | ||
| 475 | (if (funcall buttonp item indent) | ||
| 476 | (funcall (hierarchy-labelfn-button labelfn actionfn) item indent) | ||
| 477 | (funcall labelfn item indent)))) | ||
| 478 | |||
| 479 | (defun hierarchy-labelfn-to-string (labelfn item indent) | ||
| 480 | "Execute LABELFN on ITEM and INDENT. Return result as a string." | ||
| 481 | (with-temp-buffer | ||
| 482 | (funcall labelfn item indent) | ||
| 483 | (buffer-substring (point-min) (point-max)))) | ||
| 484 | |||
| 485 | (defun hierarchy-print (hierarchy &optional to-string) | ||
| 486 | "Insert HIERARCHY in current buffer as plain text. | ||
| 487 | |||
| 488 | Use TO-STRING to convert each element to a string. TO-STRING is | ||
| 489 | a function taking an item of HIERARCHY as input and returning a | ||
| 490 | string. If nil, TO-STRING defaults to a call to `format' with \"%s\"." | ||
| 491 | (let ((to-string (or to-string (lambda (item) (format "%s" item))))) | ||
| 492 | (hierarchy-map | ||
| 493 | (hierarchy-labelfn-indent (lambda (item _) | ||
| 494 | (insert (funcall to-string item) "\n"))) | ||
| 495 | hierarchy))) | ||
| 496 | |||
| 497 | (defun hierarchy-to-string (hierarchy &optional to-string) | ||
| 498 | "Return a string representing HIERARCHY. | ||
| 499 | |||
| 500 | TO-STRING is passed unchanged to `hierarchy-print'." | ||
| 501 | (with-temp-buffer | ||
| 502 | (hierarchy-print hierarchy to-string) | ||
| 503 | (buffer-substring (point-min) (point-max)))) | ||
| 504 | |||
| 505 | (defun hierarchy-tabulated-imenu-action (_item-name position) | ||
| 506 | "Move to ITEM-NAME at POSITION in current buffer." | ||
| 507 | (goto-char position) | ||
| 508 | (back-to-indentation)) | ||
| 509 | |||
| 510 | (define-derived-mode hierarchy-tabulated-mode tabulated-list-mode "Hierarchy tabulated" | ||
| 511 | "Major mode to display a hierarchy as a tabulated list." | ||
| 512 | (setq-local imenu-generic-expression | ||
| 513 | ;; debbugs: 26457 - Cannot pass a function to | ||
| 514 | ;; imenu-generic-expression. Add | ||
| 515 | ;; `hierarchy-tabulated-imenu-action' to the end of the | ||
| 516 | ;; list when bug is fixed | ||
| 517 | '(("Item" "^[[:space:]]+\\(?1:.+\\)$" 1)))) | ||
| 518 | |||
| 519 | (defun hierarchy-tabulated-display (hierarchy labelfn &optional buffer) | ||
| 520 | "Display HIERARCHY as a tabulated list in `hierarchy-tabulated-mode'. | ||
| 521 | |||
| 522 | LABELFN is a function taking an item of HIERARCHY and an indentation | ||
| 523 | level (a number) as input and inserting a string to be displayed in the | ||
| 524 | table. | ||
| 525 | |||
| 526 | The tabulated list is displayed in BUFFER, or a newly created buffer if | ||
| 527 | nil. The buffer is returned." | ||
| 528 | (let ((buffer (or buffer (generate-new-buffer "hierarchy-tabulated")))) | ||
| 529 | (with-current-buffer buffer | ||
| 530 | (hierarchy-tabulated-mode) | ||
| 531 | (setq tabulated-list-format | ||
| 532 | (vector '("Item name" 0 nil))) | ||
| 533 | (setq tabulated-list-entries | ||
| 534 | (hierarchy-map (lambda (item indent) | ||
| 535 | (list item (vector (hierarchy-labelfn-to-string | ||
| 536 | labelfn item indent)))) | ||
| 537 | hierarchy)) | ||
| 538 | (tabulated-list-init-header) | ||
| 539 | (tabulated-list-print)) | ||
| 540 | buffer)) | ||
| 541 | |||
| 542 | (declare-function widget-convert "wid-edit") | ||
| 543 | (defun hierarchy-convert-to-tree-widget (hierarchy labelfn) | ||
| 544 | "Return a tree-widget for HIERARCHY. | ||
| 545 | |||
| 546 | LABELFN is a function taking an item of HIERARCHY and an indentation | ||
| 547 | value (a number) as parameter and inserting a string to be displayed as a | ||
| 548 | node label." | ||
| 549 | (require 'wid-edit) | ||
| 550 | (require 'tree-widget) | ||
| 551 | (hierarchy-map-tree (lambda (item indent children) | ||
| 552 | (widget-convert | ||
| 553 | 'tree-widget | ||
| 554 | :tag (hierarchy-labelfn-to-string labelfn item indent) | ||
| 555 | :args children)) | ||
| 556 | hierarchy)) | ||
| 557 | |||
| 558 | (defun hierarchy-tree-display (hierarchy labelfn &optional buffer) | ||
| 559 | "Display HIERARCHY as a tree widget in a new buffer. | ||
| 560 | |||
| 561 | HIERARCHY and LABELFN are passed unchanged to | ||
| 562 | `hierarchy-convert-to-tree-widget'. | ||
| 563 | |||
| 564 | The tree widget is displayed in BUFFER, or a newly created buffer if | ||
| 565 | nil. The buffer is returned." | ||
| 566 | (let ((buffer (or buffer (generate-new-buffer "*hierarchy-tree*"))) | ||
| 567 | (tree-widget (hierarchy-convert-to-tree-widget hierarchy labelfn))) | ||
| 568 | (with-current-buffer buffer | ||
| 569 | (setq-local buffer-read-only t) | ||
| 570 | (let ((inhibit-read-only t)) | ||
| 571 | (erase-buffer) | ||
| 572 | (widget-create tree-widget) | ||
| 573 | (goto-char (point-min)) | ||
| 574 | (special-mode))) | ||
| 575 | buffer)) | ||
| 576 | |||
| 577 | (provide 'hierarchy) | ||
| 578 | |||
| 579 | ;;; hierarchy.el ends here | ||
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 4c1a1797adc..1cc68e19edd 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el | |||
| @@ -492,6 +492,7 @@ keys. Keys are compared using `equal'." | |||
| 492 | SEQUENCE must be a sequence of numbers or markers." | 492 | SEQUENCE must be a sequence of numbers or markers." |
| 493 | (apply #'min (seq-into sequence 'list))) | 493 | (apply #'min (seq-into sequence 'list))) |
| 494 | 494 | ||
| 495 | ;;;###autoload | ||
| 495 | (cl-defgeneric seq-max (sequence) | 496 | (cl-defgeneric seq-max (sequence) |
| 496 | "Return the largest element of SEQUENCE. | 497 | "Return the largest element of SEQUENCE. |
| 497 | SEQUENCE must be a sequence of numbers or markers." | 498 | SEQUENCE must be a sequence of numbers or markers." |
diff --git a/lisp/epa-file.el b/lisp/epa-file.el index 20043a9eae4..bbd9279a9a8 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el | |||
| @@ -151,17 +151,25 @@ encryption is used." | |||
| 151 | (nth 3 error))) | 151 | (nth 3 error))) |
| 152 | (let ((exists (file-exists-p local-file))) | 152 | (let ((exists (file-exists-p local-file))) |
| 153 | (when exists | 153 | (when exists |
| 154 | ;; Hack to prevent find-file from opening empty buffer | 154 | (epa-display-error context) |
| 155 | ;; when decryption failed (bug#6568). See the place | 155 | ;; When the .gpg file isn't an encrypted file (e.g., |
| 156 | ;; where `find-file-not-found-functions' are called in | 156 | ;; it's a keyring.gpg file instead), then gpg will |
| 157 | ;; `find-file-noselect-1'. | 157 | ;; say "Unexpected exit" as the error message. In |
| 158 | (setq-local epa-file-error error) | 158 | ;; that case, just display the bytes. |
| 159 | (add-hook 'find-file-not-found-functions | 159 | (if (equal (caddr error) "Unexpected; Exit") |
| 160 | 'epa-file--find-file-not-found-function | 160 | (setq string (with-temp-buffer |
| 161 | nil t) | 161 | (insert-file-contents-literally local-file) |
| 162 | (epa-display-error context)) | 162 | (buffer-string))) |
| 163 | (signal (if exists 'file-error 'file-missing) | 163 | ;; Hack to prevent find-file from opening empty buffer |
| 164 | (cons "Opening input file" (cdr error)))))) | 164 | ;; when decryption failed (bug#6568). See the place |
| 165 | ;; where `find-file-not-found-functions' are called in | ||
| 166 | ;; `find-file-noselect-1'. | ||
| 167 | (setq-local epa-file-error error) | ||
| 168 | (add-hook 'find-file-not-found-functions | ||
| 169 | 'epa-file--find-file-not-found-function | ||
| 170 | nil t) | ||
| 171 | (signal (if exists 'file-error 'file-missing) | ||
| 172 | (cons "Opening input file" (cdr error)))))))) | ||
| 165 | (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)! | 173 | (set-buffer buf) ;In case timer/filter changed/killed it (bug#16029)! |
| 166 | (setq-local epa-file-encrypt-to | 174 | (setq-local epa-file-encrypt-to |
| 167 | (mapcar #'car (epg-context-result-for | 175 | (mapcar #'car (epg-context-result-for |
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el index fc45725f789..4afe6a7614b 100644 --- a/lisp/erc/erc-capab.el +++ b/lisp/erc/erc-capab.el | |||
| @@ -170,11 +170,11 @@ PARSED is an `erc-parsed' response struct." | |||
| 170 | (string-match "^\\([-\\+]\\)\\(.+\\)$" msg)) | 170 | (string-match "^\\([-\\+]\\)\\(.+\\)$" msg)) |
| 171 | (setf (erc-response.contents parsed) | 171 | (setf (erc-response.contents parsed) |
| 172 | (if erc-capab-identify-mode | 172 | (if erc-capab-identify-mode |
| 173 | (erc-propertize (match-string 2 msg) | 173 | (propertize (match-string 2 msg) |
| 174 | 'erc-identified | 174 | 'erc-identified |
| 175 | (if (string= (match-string 1 msg) "+") | 175 | (if (string= (match-string 1 msg) "+") |
| 176 | 1 | 176 | 1 |
| 177 | 0)) | 177 | 0)) |
| 178 | (match-string 2 msg))) | 178 | (match-string 2 msg))) |
| 179 | nil))) | 179 | nil))) |
| 180 | 180 | ||
| @@ -190,9 +190,9 @@ PARSED is an `erc-parsed' response struct." | |||
| 190 | ;; assuming the first use of `nickname' is the sender's nick | 190 | ;; assuming the first use of `nickname' is the sender's nick |
| 191 | (re-search-forward (regexp-quote nickname) nil t)) | 191 | (re-search-forward (regexp-quote nickname) nil t)) |
| 192 | (goto-char (match-beginning 0)) | 192 | (goto-char (match-beginning 0)) |
| 193 | (insert (erc-propertize erc-capab-identify-prefix | 193 | (insert (propertize erc-capab-identify-prefix |
| 194 | 'font-lock-face | 194 | 'font-lock-face |
| 195 | 'erc-capab-identify-unidentified)))))) | 195 | 'erc-capab-identify-unidentified)))))) |
| 196 | 196 | ||
| 197 | (defun erc-capab-identify-get-unidentified-nickname (parsed) | 197 | (defun erc-capab-identify-get-unidentified-nickname (parsed) |
| 198 | "Return the nickname of the user if unidentified. | 198 | "Return the nickname of the user if unidentified. |
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 388728b04a0..d71221b2674 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el | |||
| @@ -43,12 +43,12 @@ Return the same string, if the encoding operation is trivial. | |||
| 43 | See `erc-encoding-coding-alist'." | 43 | See `erc-encoding-coding-alist'." |
| 44 | (encode-coding-string s coding-system t)) | 44 | (encode-coding-string s coding-system t)) |
| 45 | 45 | ||
| 46 | (defalias 'erc-propertize 'propertize) | 46 | (define-obsolete-function-alias 'erc-propertize #'propertize "28.1") |
| 47 | (defalias 'erc-view-mode-enter 'view-mode-enter) | 47 | (define-obsolete-function-alias 'erc-view-mode-enter #'view-mode-enter "28.1") |
| 48 | (autoload 'help-function-arglist "help-fns") | 48 | (autoload 'help-function-arglist "help-fns") |
| 49 | (defalias 'erc-function-arglist 'help-function-arglist) | 49 | (define-obsolete-function-alias 'erc-function-arglist #'help-function-arglist "28.1") |
| 50 | (defalias 'erc-delete-dups 'delete-dups) | 50 | (define-obsolete-function-alias 'erc-delete-dups #'delete-dups "28.1") |
| 51 | (defalias 'erc-replace-regexp-in-string 'replace-regexp-in-string) | 51 | (define-obsolete-function-alias 'erc-replace-regexp-in-string #'replace-regexp-in-string "28.1") |
| 52 | 52 | ||
| 53 | (defun erc-set-write-file-functions (new-val) | 53 | (defun erc-set-write-file-functions (new-val) |
| 54 | (set (make-local-variable 'write-file-functions) new-val)) | 54 | (set (make-local-variable 'write-file-functions) new-val)) |
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el index 8ccceec4594..bf98eb818f3 100644 --- a/lisp/erc/erc-dcc.el +++ b/lisp/erc/erc-dcc.el | |||
| @@ -423,7 +423,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc." | |||
| 423 | #'(lambda (elt) | 423 | #'(lambda (elt) |
| 424 | (eq (plist-get elt :type) 'CHAT)) | 424 | (eq (plist-get elt :type) 'CHAT)) |
| 425 | erc-dcc-list))) | 425 | erc-dcc-list))) |
| 426 | ('close (erc-delete-dups | 426 | ('close (delete-dups |
| 427 | (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) | 427 | (mapcar (lambda (elt) (symbol-name (plist-get elt :type))) |
| 428 | erc-dcc-list))) | 428 | erc-dcc-list))) |
| 429 | ('get (mapcar #'erc-dcc-nick | 429 | ('get (mapcar #'erc-dcc-nick |
| @@ -636,8 +636,8 @@ that subcommand." | |||
| 636 | 636 | ||
| 637 | (define-inline erc-dcc-unquote-filename (filename) | 637 | (define-inline erc-dcc-unquote-filename (filename) |
| 638 | (inline-quote | 638 | (inline-quote |
| 639 | (erc-replace-regexp-in-string "\\\\\\\\" "\\" | 639 | (replace-regexp-in-string "\\\\\\\\" "\\" |
| 640 | (erc-replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t))) | 640 | (replace-regexp-in-string "\\\\\"" "\"" ,filename t t) t t))) |
| 641 | 641 | ||
| 642 | (defun erc-dcc-handle-ctcp-send (proc query nick login host to) | 642 | (defun erc-dcc-handle-ctcp-send (proc query nick login host to) |
| 643 | "This is called if a CTCP DCC SEND subcommand is sent to the client. | 643 | "This is called if a CTCP DCC SEND subcommand is sent to the client. |
| @@ -1193,8 +1193,8 @@ other client." | |||
| 1193 | (setq posn (match-end 0)) | 1193 | (setq posn (match-end 0)) |
| 1194 | (erc-display-message | 1194 | (erc-display-message |
| 1195 | nil nil proc | 1195 | nil nil proc |
| 1196 | 'dcc-chat-privmsg ?n (erc-propertize erc-dcc-from 'font-lock-face | 1196 | 'dcc-chat-privmsg ?n (propertize erc-dcc-from 'font-lock-face |
| 1197 | 'erc-nick-default-face) ?m line)) | 1197 | 'erc-nick-default-face) ?m line)) |
| 1198 | (setq erc-dcc-unprocessed-output (substring str posn))))) | 1198 | (setq erc-dcc-unprocessed-output (substring str posn))))) |
| 1199 | 1199 | ||
| 1200 | (defun erc-dcc-chat-buffer-killed () | 1200 | (defun erc-dcc-chat-buffer-killed () |
diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el index 5faeabb721a..036d7733ed7 100644 --- a/lisp/erc/erc-list.el +++ b/lisp/erc/erc-list.el | |||
| @@ -71,13 +71,13 @@ | |||
| 71 | (defun erc-list-make-string (channel users topic) | 71 | (defun erc-list-make-string (channel users topic) |
| 72 | (concat | 72 | (concat |
| 73 | channel | 73 | channel |
| 74 | (erc-propertize " " | 74 | (propertize " " |
| 75 | 'display (list 'space :align-to erc-list-nusers-column) | 75 | 'display (list 'space :align-to erc-list-nusers-column) |
| 76 | 'face 'fixed-pitch) | 76 | 'face 'fixed-pitch) |
| 77 | users | 77 | users |
| 78 | (erc-propertize " " | 78 | (propertize " " |
| 79 | 'display (list 'space :align-to erc-list-topic-column) | 79 | 'display (list 'space :align-to erc-list-topic-column) |
| 80 | 'face 'fixed-pitch) | 80 | 'face 'fixed-pitch) |
| 81 | topic)) | 81 | topic)) |
| 82 | 82 | ||
| 83 | ;; Insert a record into the list buffer. | 83 | ;; Insert a record into the list buffer. |
| @@ -143,19 +143,19 @@ | |||
| 143 | 143 | ||
| 144 | ;; Helper function that makes a buttonized column header. | 144 | ;; Helper function that makes a buttonized column header. |
| 145 | (defun erc-list-button (title column) | 145 | (defun erc-list-button (title column) |
| 146 | (erc-propertize title | 146 | (propertize title |
| 147 | 'column-number column | 147 | 'column-number column |
| 148 | 'help-echo "mouse-1: sort by column" | 148 | 'help-echo "mouse-1: sort by column" |
| 149 | 'mouse-face 'header-line-highlight | 149 | 'mouse-face 'header-line-highlight |
| 150 | 'keymap erc-list-menu-sort-button-map)) | 150 | 'keymap erc-list-menu-sort-button-map)) |
| 151 | 151 | ||
| 152 | (define-derived-mode erc-list-menu-mode special-mode "ERC-List" | 152 | (define-derived-mode erc-list-menu-mode special-mode "ERC-List" |
| 153 | "Major mode for editing a list of irc channels." | 153 | "Major mode for editing a list of irc channels." |
| 154 | (setq header-line-format | 154 | (setq header-line-format |
| 155 | (concat | 155 | (concat |
| 156 | (erc-propertize " " | 156 | (propertize " " |
| 157 | 'display '(space :align-to 0) | 157 | 'display '(space :align-to 0) |
| 158 | 'face 'fixed-pitch) | 158 | 'face 'fixed-pitch) |
| 159 | (erc-list-make-string (erc-list-button "Channel" 1) | 159 | (erc-list-make-string (erc-list-button "Channel" 1) |
| 160 | (erc-list-button "# Users" 2) | 160 | (erc-list-button "# Users" 2) |
| 161 | "Topic"))) | 161 | "Topic"))) |
diff --git a/lisp/erc/erc-log.el b/lisp/erc/erc-log.el index 1bad6d16c87..e2c066da9b1 100644 --- a/lisp/erc/erc-log.el +++ b/lisp/erc/erc-log.el | |||
| @@ -334,7 +334,7 @@ This will not work with full paths, only names. | |||
| 334 | 334 | ||
| 335 | Any unsafe characters in the name are replaced with \"!\". The | 335 | Any unsafe characters in the name are replaced with \"!\". The |
| 336 | filename is downcased." | 336 | filename is downcased." |
| 337 | (downcase (erc-replace-regexp-in-string | 337 | (downcase (replace-regexp-in-string |
| 338 | "[/\\]" "!" (convert-standard-filename filename)))) | 338 | "[/\\]" "!" (convert-standard-filename filename)))) |
| 339 | 339 | ||
| 340 | (defun erc-current-logfile (&optional buffer) | 340 | (defun erc-current-logfile (&optional buffer) |
diff --git a/lisp/erc/erc-match.el b/lisp/erc/erc-match.el index 0e98f2bc613..6e87a183fc1 100644 --- a/lisp/erc/erc-match.el +++ b/lisp/erc/erc-match.el | |||
| @@ -577,9 +577,9 @@ See `erc-log-match-format'." | |||
| 577 | (with-current-buffer buffer | 577 | (with-current-buffer buffer |
| 578 | (unless buffer-already | 578 | (unless buffer-already |
| 579 | (insert " == Type \"q\" to dismiss messages ==\n") | 579 | (insert " == Type \"q\" to dismiss messages ==\n") |
| 580 | (erc-view-mode-enter nil (lambda (buffer) | 580 | (view-mode-enter nil (lambda (buffer) |
| 581 | (when (y-or-n-p "Discard messages? ") | 581 | (when (y-or-n-p "Discard messages? ") |
| 582 | (kill-buffer buffer))))) | 582 | (kill-buffer buffer))))) |
| 583 | buffer))) | 583 | buffer))) |
| 584 | 584 | ||
| 585 | (defun erc-log-matches-come-back (proc parsed) | 585 | (defun erc-log-matches-come-back (proc parsed) |
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index 415fb53fee0..8551cdd1dee 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el | |||
| @@ -812,7 +812,7 @@ As an example: | |||
| 812 | (let* ((completion-ignore-case t) | 812 | (let* ((completion-ignore-case t) |
| 813 | (net (intern | 813 | (net (intern |
| 814 | (completing-read "Network: " | 814 | (completing-read "Network: " |
| 815 | (erc-delete-dups | 815 | (delete-dups |
| 816 | (mapcar (lambda (x) | 816 | (mapcar (lambda (x) |
| 817 | (list (symbol-name (nth 1 x)))) | 817 | (list (symbol-name (nth 1 x)))) |
| 818 | erc-server-alist))))) | 818 | erc-server-alist))))) |
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 8830dd4c45e..404a4c09975 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el | |||
| @@ -63,6 +63,8 @@ | |||
| 63 | (require 'thingatpt) | 63 | (require 'thingatpt) |
| 64 | (require 'auth-source) | 64 | (require 'auth-source) |
| 65 | (require 'erc-compat) | 65 | (require 'erc-compat) |
| 66 | (require 'time-date) | ||
| 67 | (require 'iso8601) | ||
| 66 | (eval-when-compile (require 'subr-x)) | 68 | (eval-when-compile (require 'subr-x)) |
| 67 | 69 | ||
| 68 | (defvar erc-official-location | 70 | (defvar erc-official-location |
| @@ -1628,9 +1630,10 @@ symbol, it may have these values: | |||
| 1628 | (and (erc-server-buffer-p) | 1630 | (and (erc-server-buffer-p) |
| 1629 | (not (erc-server-process-alive))))) | 1631 | (not (erc-server-process-alive))))) |
| 1630 | ;; Channel buffer; check that it's from the right server. | 1632 | ;; Channel buffer; check that it's from the right server. |
| 1631 | (with-current-buffer (get-buffer candidate) | 1633 | (and target |
| 1632 | (and (string= erc-session-server server) | 1634 | (with-current-buffer (get-buffer candidate) |
| 1633 | (erc-port-equal erc-session-port port))))) | 1635 | (and (string= erc-session-server server) |
| 1636 | (erc-port-equal erc-session-port port)))))) | ||
| 1634 | (setq buffer-name candidate))) | 1637 | (setq buffer-name candidate))) |
| 1635 | ;; if buffer-name is unset, neither candidate worked out for us, | 1638 | ;; if buffer-name is unset, neither candidate worked out for us, |
| 1636 | ;; fallback to the old <N> uniquification method: | 1639 | ;; fallback to the old <N> uniquification method: |
| @@ -1860,7 +1863,7 @@ buffer rather than a server buffer.") | |||
| 1860 | ;; modify `transforms' to specify what needs to be changed | 1863 | ;; modify `transforms' to specify what needs to be changed |
| 1861 | ;; each item is in the format '(old . new) | 1864 | ;; each item is in the format '(old . new) |
| 1862 | (let ((transforms '((pcomplete . completion)))) | 1865 | (let ((transforms '((pcomplete . completion)))) |
| 1863 | (erc-delete-dups | 1866 | (delete-dups |
| 1864 | (mapcar (lambda (m) (or (cdr (assoc m transforms)) m)) | 1867 | (mapcar (lambda (m) (or (cdr (assoc m transforms)) m)) |
| 1865 | mods)))) | 1868 | mods)))) |
| 1866 | 1869 | ||
| @@ -2313,7 +2316,7 @@ and appears in face `erc-input-face' in the buffer." | |||
| 2313 | (setq result (concat result network-name | 2316 | (setq result (concat result network-name |
| 2314 | " << " line "\n"))) | 2317 | " << " line "\n"))) |
| 2315 | result) | 2318 | result) |
| 2316 | (erc-propertize | 2319 | (propertize |
| 2317 | (concat network-name " >> " string | 2320 | (concat network-name " >> " string |
| 2318 | (if (/= ?\n | 2321 | (if (/= ?\n |
| 2319 | (aref string | 2322 | (aref string |
| @@ -2336,7 +2339,7 @@ If ARG is non-nil, show the *erc-protocol* buffer." | |||
| 2336 | (interactive "P") | 2339 | (interactive "P") |
| 2337 | (let* ((buf (get-buffer-create "*erc-protocol*"))) | 2340 | (let* ((buf (get-buffer-create "*erc-protocol*"))) |
| 2338 | (with-current-buffer buf | 2341 | (with-current-buffer buf |
| 2339 | (erc-view-mode-enter) | 2342 | (view-mode-enter) |
| 2340 | (when (null (current-local-map)) | 2343 | (when (null (current-local-map)) |
| 2341 | (let ((inhibit-read-only t)) | 2344 | (let ((inhibit-read-only t)) |
| 2342 | (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n")) | 2345 | (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n")) |
| @@ -2770,7 +2773,7 @@ See also `erc-server-send'." | |||
| 2770 | 2773 | ||
| 2771 | (defun erc-get-arglist (fun) | 2774 | (defun erc-get-arglist (fun) |
| 2772 | "Return the argument list of a function without the parens." | 2775 | "Return the argument list of a function without the parens." |
| 2773 | (let ((arglist (format "%S" (erc-function-arglist fun)))) | 2776 | (let ((arglist (format "%S" (help-function-arglist fun)))) |
| 2774 | (if (string-match "\\`(\\(.*\\))\\'" arglist) | 2777 | (if (string-match "\\`(\\(.*\\))\\'" arglist) |
| 2775 | (match-string 1 arglist) | 2778 | (match-string 1 arglist) |
| 2776 | arglist))) | 2779 | arglist))) |
| @@ -2905,6 +2908,44 @@ therefore has to contain the command itself as well." | |||
| 2905 | (erc-server-send (substring line 1)) | 2908 | (erc-server-send (substring line 1)) |
| 2906 | t) | 2909 | t) |
| 2907 | 2910 | ||
| 2911 | (defvar erc--read-time-period-history nil) | ||
| 2912 | |||
| 2913 | (defun erc--read-time-period (prompt) | ||
| 2914 | "Read a time period on the \"2h\" format. | ||
| 2915 | If there's no letter spec, the input is interpreted as a number of seconds. | ||
| 2916 | |||
| 2917 | If input is blank, this function returns nil. Otherwise it | ||
| 2918 | returns the time spec converted to a number of seconds." | ||
| 2919 | (let ((period (string-trim | ||
| 2920 | (read-string prompt nil 'erc--read-time-period-history)))) | ||
| 2921 | (cond | ||
| 2922 | ;; Blank input. | ||
| 2923 | ((zerop (length period)) | ||
| 2924 | nil) | ||
| 2925 | ;; All-number -- interpret as seconds. | ||
| 2926 | ((string-match-p "\\`[0-9]+\\'" period) | ||
| 2927 | (string-to-number period)) | ||
| 2928 | ;; Parse as a time spec. | ||
| 2929 | (t | ||
| 2930 | (let ((time (condition-case nil | ||
| 2931 | (iso8601-parse-duration | ||
| 2932 | (concat (cond | ||
| 2933 | ((string-match-p "\\`P" (upcase period)) | ||
| 2934 | ;; Somebody typed in a full ISO8601 period. | ||
| 2935 | (upcase period)) | ||
| 2936 | ((string-match-p "[YD]" (upcase period)) | ||
| 2937 | ;; If we have a year/day element, | ||
| 2938 | ;; we have a full spec. | ||
| 2939 | "P") | ||
| 2940 | (t | ||
| 2941 | ;; Otherwise it's just a sub-day spec. | ||
| 2942 | "PT")) | ||
| 2943 | (upcase period))) | ||
| 2944 | (wrong-type-argument nil)))) | ||
| 2945 | (unless time | ||
| 2946 | (user-error "%s is not a valid time period" period)) | ||
| 2947 | (decoded-time-period time)))))) | ||
| 2948 | |||
| 2908 | (defun erc-cmd-IGNORE (&optional user) | 2949 | (defun erc-cmd-IGNORE (&optional user) |
| 2909 | "Ignore USER. This should be a regexp matching nick!user@host. | 2950 | "Ignore USER. This should be a regexp matching nick!user@host. |
| 2910 | If no USER argument is specified, list the contents of `erc-ignore-list'." | 2951 | If no USER argument is specified, list the contents of `erc-ignore-list'." |
| @@ -2914,10 +2955,18 @@ If no USER argument is specified, list the contents of `erc-ignore-list'." | |||
| 2914 | (y-or-n-p (format "Use regexp-quoted form (%s) instead? " | 2955 | (y-or-n-p (format "Use regexp-quoted form (%s) instead? " |
| 2915 | quoted))) | 2956 | quoted))) |
| 2916 | (setq user quoted)) | 2957 | (setq user quoted)) |
| 2917 | (erc-display-line | 2958 | (let ((timeout |
| 2918 | (erc-make-notice (format "Now ignoring %s" user)) | 2959 | (erc--read-time-period |
| 2919 | 'active) | 2960 | "Add a timeout? (Blank for no, or a time spec like 2h): ")) |
| 2920 | (erc-with-server-buffer (add-to-list 'erc-ignore-list user))) | 2961 | (buffer (current-buffer))) |
| 2962 | (when timeout | ||
| 2963 | (run-at-time timeout nil | ||
| 2964 | (lambda () | ||
| 2965 | (erc--unignore-user user buffer)))) | ||
| 2966 | (erc-display-line | ||
| 2967 | (erc-make-notice (format "Now ignoring %s" user)) | ||
| 2968 | 'active) | ||
| 2969 | (erc-with-server-buffer (add-to-list 'erc-ignore-list user)))) | ||
| 2921 | (if (null (erc-with-server-buffer erc-ignore-list)) | 2970 | (if (null (erc-with-server-buffer erc-ignore-list)) |
| 2922 | (erc-display-line (erc-make-notice "Ignore list is empty") 'active) | 2971 | (erc-display-line (erc-make-notice "Ignore list is empty") 'active) |
| 2923 | (erc-display-line (erc-make-notice "Ignore list:") 'active) | 2972 | (erc-display-line (erc-make-notice "Ignore list:") 'active) |
| @@ -2941,12 +2990,17 @@ If no USER argument is specified, list the contents of `erc-ignore-list'." | |||
| 2941 | (erc-make-notice (format "%s is not currently ignored!" user)) | 2990 | (erc-make-notice (format "%s is not currently ignored!" user)) |
| 2942 | 'active))) | 2991 | 'active))) |
| 2943 | (when ignored-nick | 2992 | (when ignored-nick |
| 2993 | (erc--unignore-user user (current-buffer)))) | ||
| 2994 | t) | ||
| 2995 | |||
| 2996 | (defun erc--unignore-user (user buffer) | ||
| 2997 | (when (buffer-live-p buffer) | ||
| 2998 | (with-current-buffer buffer | ||
| 2944 | (erc-display-line | 2999 | (erc-display-line |
| 2945 | (erc-make-notice (format "No longer ignoring %s" user)) | 3000 | (erc-make-notice (format "No longer ignoring %s" user)) |
| 2946 | 'active) | 3001 | 'active) |
| 2947 | (erc-with-server-buffer | 3002 | (erc-with-server-buffer |
| 2948 | (setq erc-ignore-list (delete ignored-nick erc-ignore-list))))) | 3003 | (setq erc-ignore-list (delete user erc-ignore-list)))))) |
| 2949 | t) | ||
| 2950 | 3004 | ||
| 2951 | (defun erc-cmd-CLEAR () | 3005 | (defun erc-cmd-CLEAR () |
| 2952 | "Clear the window content." | 3006 | "Clear the window content." |
| @@ -3504,7 +3558,7 @@ If S is non-nil, it will be used as the quit reason." | |||
| 3504 | If S is non-nil, it will be used as the quit reason." | 3558 | If S is non-nil, it will be used as the quit reason." |
| 3505 | (or s | 3559 | (or s |
| 3506 | (if (fboundp 'yow) | 3560 | (if (fboundp 'yow) |
| 3507 | (erc-replace-regexp-in-string "\n" "" (yow)) | 3561 | (replace-regexp-in-string "\n" "" (yow)) |
| 3508 | (erc-quit/part-reason-default)))) | 3562 | (erc-quit/part-reason-default)))) |
| 3509 | 3563 | ||
| 3510 | (make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4") | 3564 | (make-obsolete 'erc-quit-reason-zippy "it will be removed." "24.4") |
| @@ -3531,7 +3585,7 @@ If S is non-nil, it will be used as the part reason." | |||
| 3531 | If S is non-nil, it will be used as the quit reason." | 3585 | If S is non-nil, it will be used as the quit reason." |
| 3532 | (or s | 3586 | (or s |
| 3533 | (if (fboundp 'yow) | 3587 | (if (fboundp 'yow) |
| 3534 | (erc-replace-regexp-in-string "\n" "" (yow)) | 3588 | (replace-regexp-in-string "\n" "" (yow)) |
| 3535 | (erc-quit/part-reason-default)))) | 3589 | (erc-quit/part-reason-default)))) |
| 3536 | 3590 | ||
| 3537 | (make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4") | 3591 | (make-obsolete 'erc-part-reason-zippy "it will be removed." "24.4") |
| @@ -3947,13 +4001,13 @@ If FACE is non-nil, it will be used to propertize the prompt. If it is nil, | |||
| 3947 | ;; Do not extend the text properties when typing at the end | 4001 | ;; Do not extend the text properties when typing at the end |
| 3948 | ;; of the prompt, but stuff typed in front of the prompt | 4002 | ;; of the prompt, but stuff typed in front of the prompt |
| 3949 | ;; shall remain part of the prompt. | 4003 | ;; shall remain part of the prompt. |
| 3950 | (setq prompt (erc-propertize prompt | 4004 | (setq prompt (propertize prompt |
| 3951 | 'start-open t ; XEmacs | 4005 | 'start-open t ; XEmacs |
| 3952 | 'rear-nonsticky t ; Emacs | 4006 | 'rear-nonsticky t ; Emacs |
| 3953 | 'erc-prompt t | 4007 | 'erc-prompt t |
| 3954 | 'field t | 4008 | 'field t |
| 3955 | 'front-sticky t | 4009 | 'front-sticky t |
| 3956 | 'read-only t)) | 4010 | 'read-only t)) |
| 3957 | (erc-put-text-property 0 (1- (length prompt)) | 4011 | (erc-put-text-property 0 (1- (length prompt)) |
| 3958 | 'font-lock-face (or face 'erc-prompt-face) | 4012 | 'font-lock-face (or face 'erc-prompt-face) |
| 3959 | prompt) | 4013 | prompt) |
| @@ -4336,15 +4390,15 @@ See also `erc-format-nick-function'." | |||
| 4336 | (defun erc-get-user-mode-prefix (user) | 4390 | (defun erc-get-user-mode-prefix (user) |
| 4337 | (when user | 4391 | (when user |
| 4338 | (cond ((erc-channel-user-owner-p user) | 4392 | (cond ((erc-channel-user-owner-p user) |
| 4339 | (erc-propertize "~" 'help-echo "owner")) | 4393 | (propertize "~" 'help-echo "owner")) |
| 4340 | ((erc-channel-user-admin-p user) | 4394 | ((erc-channel-user-admin-p user) |
| 4341 | (erc-propertize "&" 'help-echo "admin")) | 4395 | (propertize "&" 'help-echo "admin")) |
| 4342 | ((erc-channel-user-op-p user) | 4396 | ((erc-channel-user-op-p user) |
| 4343 | (erc-propertize "@" 'help-echo "operator")) | 4397 | (propertize "@" 'help-echo "operator")) |
| 4344 | ((erc-channel-user-halfop-p user) | 4398 | ((erc-channel-user-halfop-p user) |
| 4345 | (erc-propertize "%" 'help-echo "half-op")) | 4399 | (propertize "%" 'help-echo "half-op")) |
| 4346 | ((erc-channel-user-voice-p user) | 4400 | ((erc-channel-user-voice-p user) |
| 4347 | (erc-propertize "+" 'help-echo "voice")) | 4401 | (propertize "+" 'help-echo "voice")) |
| 4348 | (t "")))) | 4402 | (t "")))) |
| 4349 | 4403 | ||
| 4350 | (defun erc-format-@nick (&optional user _channel-data) | 4404 | (defun erc-format-@nick (&optional user _channel-data) |
| @@ -4355,7 +4409,7 @@ prefix. Use CHANNEL-DATA to determine op and voice status. See | |||
| 4355 | also `erc-format-nick-function'." | 4409 | also `erc-format-nick-function'." |
| 4356 | (when user | 4410 | (when user |
| 4357 | (let ((nick (erc-server-user-nickname user))) | 4411 | (let ((nick (erc-server-user-nickname user))) |
| 4358 | (concat (erc-propertize | 4412 | (concat (propertize |
| 4359 | (erc-get-user-mode-prefix nick) | 4413 | (erc-get-user-mode-prefix nick) |
| 4360 | 'font-lock-face 'erc-nick-prefix-face) | 4414 | 'font-lock-face 'erc-nick-prefix-face) |
| 4361 | nick)))) | 4415 | nick)))) |
| @@ -4368,12 +4422,12 @@ also `erc-format-nick-function'." | |||
| 4368 | (nick (erc-current-nick)) | 4422 | (nick (erc-current-nick)) |
| 4369 | (mode (erc-get-user-mode-prefix nick))) | 4423 | (mode (erc-get-user-mode-prefix nick))) |
| 4370 | (concat | 4424 | (concat |
| 4371 | (erc-propertize open 'font-lock-face 'erc-default-face) | 4425 | (propertize open 'font-lock-face 'erc-default-face) |
| 4372 | (erc-propertize mode 'font-lock-face 'erc-my-nick-prefix-face) | 4426 | (propertize mode 'font-lock-face 'erc-my-nick-prefix-face) |
| 4373 | (erc-propertize nick 'font-lock-face 'erc-my-nick-face) | 4427 | (propertize nick 'font-lock-face 'erc-my-nick-face) |
| 4374 | (erc-propertize close 'font-lock-face 'erc-default-face))) | 4428 | (propertize close 'font-lock-face 'erc-default-face))) |
| 4375 | (let ((prefix "> ")) | 4429 | (let ((prefix "> ")) |
| 4376 | (erc-propertize prefix 'font-lock-face 'erc-default-face)))) | 4430 | (propertize prefix 'font-lock-face 'erc-default-face)))) |
| 4377 | 4431 | ||
| 4378 | (defun erc-echo-notice-in-default-buffer (s parsed buffer _sender) | 4432 | (defun erc-echo-notice-in-default-buffer (s parsed buffer _sender) |
| 4379 | "Echos a private notice in the default buffer, namely the | 4433 | "Echos a private notice in the default buffer, namely the |
| @@ -6435,16 +6489,16 @@ if `erc-away' is non-nil." | |||
| 6435 | (fill-region (point-min) (point-max)) | 6489 | (fill-region (point-min) (point-max)) |
| 6436 | (buffer-string)))) | 6490 | (buffer-string)))) |
| 6437 | (setq header-line-format | 6491 | (setq header-line-format |
| 6438 | (erc-replace-regexp-in-string | 6492 | (replace-regexp-in-string |
| 6439 | "%" | 6493 | "%" |
| 6440 | "%%" | 6494 | "%%" |
| 6441 | (if face | 6495 | (if face |
| 6442 | (erc-propertize header 'help-echo help-echo | 6496 | (propertize header 'help-echo help-echo |
| 6443 | 'face face) | 6497 | 'face face) |
| 6444 | (erc-propertize header 'help-echo help-echo)))))) | 6498 | (propertize header 'help-echo help-echo)))))) |
| 6445 | (t (setq header-line-format | 6499 | (t (setq header-line-format |
| 6446 | (if face | 6500 | (if face |
| 6447 | (erc-propertize header 'face face) | 6501 | (propertize header 'face face) |
| 6448 | header))))))) | 6502 | header))))))) |
| 6449 | (force-mode-line-update))) | 6503 | (force-mode-line-update))) |
| 6450 | 6504 | ||
| @@ -6711,7 +6765,7 @@ functions." | |||
| 6711 | nick user host channel | 6765 | nick user host channel |
| 6712 | (if (not (string= reason "")) | 6766 | (if (not (string= reason "")) |
| 6713 | (format ": %s" | 6767 | (format ": %s" |
| 6714 | (erc-replace-regexp-in-string "%" "%%" reason)) | 6768 | (replace-regexp-in-string "%" "%%" reason)) |
| 6715 | ""))))) | 6769 | ""))))) |
| 6716 | 6770 | ||
| 6717 | 6771 | ||
diff --git a/lisp/files.el b/lisp/files.el index 742fd78df1d..19096693461 100644 --- a/lisp/files.el +++ b/lisp/files.el | |||
| @@ -2683,8 +2683,6 @@ since only a single case-insensitive search through the alist is made." | |||
| 2683 | ("\\.p\\'" . pascal-mode) | 2683 | ("\\.p\\'" . pascal-mode) |
| 2684 | ("\\.pas\\'" . pascal-mode) | 2684 | ("\\.pas\\'" . pascal-mode) |
| 2685 | ("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode) | 2685 | ("\\.\\(dpr\\|DPR\\)\\'" . delphi-mode) |
| 2686 | ("\\.ad[abs]\\'" . ada-mode) | ||
| 2687 | ("\\.ad[bs]\\.dg\\'" . ada-mode) | ||
| 2688 | ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) | 2686 | ("\\.\\([pP]\\([Llm]\\|erl\\|od\\)\\|al\\)\\'" . perl-mode) |
| 2689 | ("Imakefile\\'" . makefile-imake-mode) | 2687 | ("Imakefile\\'" . makefile-imake-mode) |
| 2690 | ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk | 2688 | ("Makeppfile\\(?:\\.mk\\)?\\'" . makefile-makepp-mode) ; Put this before .mk |
diff --git a/lisp/finder.el b/lisp/finder.el index f04d73e098f..820d6d0a3b9 100644 --- a/lisp/finder.el +++ b/lisp/finder.el | |||
| @@ -197,7 +197,7 @@ from; the default is `load-path'." | |||
| 197 | (cons d f)) | 197 | (cons d f)) |
| 198 | (directory-files d nil el-file-regexp)))) | 198 | (directory-files d nil el-file-regexp)))) |
| 199 | (progress (make-progress-reporter | 199 | (progress (make-progress-reporter |
| 200 | (byte-compile-info-string "Scanning files for finder") | 200 | (byte-compile-info "Scanning files for finder") |
| 201 | 0 (length files))) | 201 | 0 (length files))) |
| 202 | package-override base-name ; processed | 202 | package-override base-name ; processed |
| 203 | summary keywords package version entry desc) | 203 | summary keywords package version entry desc) |
diff --git a/lisp/generic-x.el b/lisp/generic-x.el index cd24f497c96..48ac1232051 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el | |||
| @@ -643,7 +643,7 @@ like an INI file. You can add this hook to `find-file-hook'." | |||
| 643 | ("\\([^ =\n\r]+\\)=\\([^ \n\r]*\\)" | 643 | ("\\([^ =\n\r]+\\)=\\([^ \n\r]*\\)" |
| 644 | (1 font-lock-variable-name-face) | 644 | (1 font-lock-variable-name-face) |
| 645 | (2 font-lock-keyword-face))) | 645 | (2 font-lock-keyword-face))) |
| 646 | '("inventory") | 646 | '("inventory\\'") |
| 647 | (list | 647 | (list |
| 648 | (function | 648 | (function |
| 649 | (lambda () | 649 | (lambda () |
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index cb20d7102bd..e0339cc1f32 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el | |||
| @@ -5849,7 +5849,10 @@ all parts." | |||
| 5849 | (concat "; " gnus-tmp-name)))) | 5849 | (concat "; " gnus-tmp-name)))) |
| 5850 | (unless (equal gnus-tmp-description "") | 5850 | (unless (equal gnus-tmp-description "") |
| 5851 | (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) | 5851 | (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long))) |
| 5852 | (when (zerop gnus-tmp-length) | 5852 | (when (and (zerop gnus-tmp-length) |
| 5853 | ;; Only nnimap supports partial fetches so far. | ||
| 5854 | nnimap-fetch-partial-articles | ||
| 5855 | (string-match "^nnimap\\+" gnus-newsgroup-name)) | ||
| 5853 | (setq gnus-tmp-type-long | 5856 | (setq gnus-tmp-type-long |
| 5854 | (concat | 5857 | (concat |
| 5855 | gnus-tmp-type-long | 5858 | gnus-tmp-type-long |
| @@ -6018,6 +6021,7 @@ If nil, don't show those extra buttons." | |||
| 6018 | (defun gnus-mime-display-single (handle) | 6021 | (defun gnus-mime-display-single (handle) |
| 6019 | (let ((type (mm-handle-media-type handle)) | 6022 | (let ((type (mm-handle-media-type handle)) |
| 6020 | (ignored gnus-ignored-mime-types) | 6023 | (ignored gnus-ignored-mime-types) |
| 6024 | (mm-inline-font-lock (gnus-visual-p 'article-highlight 'highlight)) | ||
| 6021 | (not-attachment t) | 6025 | (not-attachment t) |
| 6022 | display text) | 6026 | display text) |
| 6023 | (catch 'ignored | 6027 | (catch 'ignored |
| @@ -8340,6 +8344,7 @@ url is put as the `gnus-button-url' overlay property on the button." | |||
| 8340 | (and (match-end 6) (list (string-to-number (match-string 6 address)))))))) | 8344 | (and (match-end 6) (list (string-to-number (match-string 6 address)))))))) |
| 8341 | 8345 | ||
| 8342 | (defun gnus-url-parse-query-string (query &optional downcase) | 8346 | (defun gnus-url-parse-query-string (query &optional downcase) |
| 8347 | (declare (obsolete message-parse-mailto-url "28.1")) | ||
| 8343 | (let (retval pairs cur key val) | 8348 | (let (retval pairs cur key val) |
| 8344 | (setq pairs (split-string query "&")) | 8349 | (setq pairs (split-string query "&")) |
| 8345 | (while pairs | 8350 | (while pairs |
| @@ -8359,31 +8364,8 @@ url is put as the `gnus-button-url' overlay property on the button." | |||
| 8359 | 8364 | ||
| 8360 | (defun gnus-url-mailto (url) | 8365 | (defun gnus-url-mailto (url) |
| 8361 | ;; Send mail to someone | 8366 | ;; Send mail to someone |
| 8362 | (setq url (replace-regexp-in-string "\n" " " url)) | 8367 | (gnus-msg-mail) |
| 8363 | (when (string-match "mailto:/*\\(.*\\)" url) | 8368 | (message-mailto-1 url)) |
| 8364 | (setq url (substring url (match-beginning 1) nil))) | ||
| 8365 | (let* ((args (gnus-url-parse-query-string | ||
| 8366 | (if (string-match "^\\?" url) | ||
| 8367 | (substring url 1) | ||
| 8368 | (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) | ||
| 8369 | (concat "to=" (match-string 1 url) "&" | ||
| 8370 | (match-string 2 url)) | ||
| 8371 | (concat "to=" url))))) | ||
| 8372 | (subject (cdr-safe (assoc "subject" args))) | ||
| 8373 | func) | ||
| 8374 | (gnus-msg-mail) | ||
| 8375 | (while args | ||
| 8376 | (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) | ||
| 8377 | (if (fboundp func) | ||
| 8378 | (funcall func) | ||
| 8379 | (message-position-on-field (caar args))) | ||
| 8380 | (insert (replace-regexp-in-string | ||
| 8381 | "\r\n" "\n" | ||
| 8382 | (mapconcat #'identity (reverse (cdar args)) ", ") nil t)) | ||
| 8383 | (setq args (cdr args))) | ||
| 8384 | (if subject | ||
| 8385 | (message-goto-body) | ||
| 8386 | (message-goto-subject)))) | ||
| 8387 | 8369 | ||
| 8388 | (defun gnus-button-embedded-url (address) | 8370 | (defun gnus-button-embedded-url (address) |
| 8389 | "Activate ADDRESS with `browse-url'." | 8371 | "Activate ADDRESS with `browse-url'." |
diff --git a/lisp/gnus/gnus-icalendar.el b/lisp/gnus/gnus-icalendar.el index 305e17fd8fc..29d3e30780f 100644 --- a/lisp/gnus/gnus-icalendar.el +++ b/lisp/gnus/gnus-icalendar.el | |||
| @@ -312,7 +312,8 @@ status will be retrieved from the first matching attendee record." | |||
| 312 | 312 | ||
| 313 | (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) | 313 | (unless (gnus-icalendar-find-if (lambda (x) (string-match "^ATTENDEE" x)) |
| 314 | reply-event-lines) | 314 | reply-event-lines) |
| 315 | (error "Could not find an event attendee matching given identity")) | 315 | (lwarn 'gnus-icalendar :warning |
| 316 | "Could not find an event attendee matching given identity")) | ||
| 316 | 317 | ||
| 317 | (mapconcat #'identity `("BEGIN:VEVENT" | 318 | (mapconcat #'identity `("BEGIN:VEVENT" |
| 318 | ,@(nreverse reply-event-lines) | 319 | ,@(nreverse reply-event-lines) |
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 719498a0337..4363860eac8 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el | |||
| @@ -12284,7 +12284,7 @@ no matter what the properties `:decode' and `:headers' are." | |||
| 12284 | (interactive (gnus-interactive "P\ny")) | 12284 | (interactive (gnus-interactive "P\ny")) |
| 12285 | (require 'gnus-art) | 12285 | (require 'gnus-art) |
| 12286 | (let* ((articles (gnus-summary-work-articles n)) | 12286 | (let* ((articles (gnus-summary-work-articles n)) |
| 12287 | (result-buffer "*Shell Command Output*") | 12287 | (result-buffer shell-command-buffer-name) |
| 12288 | (all-headers (not (memq sym '(nil r)))) | 12288 | (all-headers (not (memq sym '(nil r)))) |
| 12289 | (gnus-save-all-headers (or all-headers gnus-save-all-headers)) | 12289 | (gnus-save-all-headers (or all-headers gnus-save-all-headers)) |
| 12290 | (raw (eq sym 'r)) | 12290 | (raw (eq sym 'r)) |
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 8d8956f1fb9..abe546b8cb6 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el | |||
| @@ -1654,6 +1654,7 @@ The first found will be returned if a file has hard or symbolic links." | |||
| 1654 | "To each element of LIST apply PREDICATE. | 1654 | "To each element of LIST apply PREDICATE. |
| 1655 | Return nil if LIST is no list or is empty or some test returns nil; | 1655 | Return nil if LIST is no list or is empty or some test returns nil; |
| 1656 | otherwise, return t." | 1656 | otherwise, return t." |
| 1657 | (declare (obsolete nil "28.1")) | ||
| 1657 | (when (and list (listp list)) | 1658 | (when (and list (listp list)) |
| 1658 | (let ((result (mapcar predicate list))) | 1659 | (let ((result (mapcar predicate list))) |
| 1659 | (not (memq nil result))))) | 1660 | (not (memq nil result))))) |
diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 36b28350362..baa3146e64e 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el | |||
| @@ -142,7 +142,7 @@ used to display Gnus windows." | |||
| 142 | (pipe | 142 | (pipe |
| 143 | (vertical 1.0 | 143 | (vertical 1.0 |
| 144 | (summary 0.25 point) | 144 | (summary 0.25 point) |
| 145 | ("*Shell Command Output*" 1.0))) | 145 | (shell-command-buffer-name 1.0))) |
| 146 | (bug | 146 | (bug |
| 147 | (vertical 1.0 | 147 | (vertical 1.0 |
| 148 | (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5)) | 148 | (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5)) |
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index fb560f0eab8..ab625be9e37 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el | |||
| @@ -303,6 +303,13 @@ any confusion." | |||
| 303 | :link '(custom-manual "(message)Message Headers") | 303 | :link '(custom-manual "(message)Message Headers") |
| 304 | :type 'regexp) | 304 | :type 'regexp) |
| 305 | 305 | ||
| 306 | (defcustom message-screenshot-command '("import" "png:-") | ||
| 307 | "Command to take a screenshot. | ||
| 308 | The command should insert a PNG in the current buffer." | ||
| 309 | :group 'message-various | ||
| 310 | :type '(list string) | ||
| 311 | :version "28.1") | ||
| 312 | |||
| 306 | ;;; Start of variables adopted from `message-utils.el'. | 313 | ;;; Start of variables adopted from `message-utils.el'. |
| 307 | 314 | ||
| 308 | (defcustom message-subject-trailing-was-query t | 315 | (defcustom message-subject-trailing-was-query t |
| @@ -2730,6 +2737,64 @@ systematically send encrypted emails when possible." | |||
| 2730 | (when (message-all-epg-keys-available-p) | 2737 | (when (message-all-epg-keys-available-p) |
| 2731 | (mml-secure-message-sign-encrypt))) | 2738 | (mml-secure-message-sign-encrypt))) |
| 2732 | 2739 | ||
| 2740 | (defcustom message-openpgp-header nil | ||
| 2741 | "Specification for the \"OpenPGP\" header of outgoing messages. | ||
| 2742 | |||
| 2743 | The value must be a list of three elements, all strings: | ||
| 2744 | - Key ID, in hexadecimal form; | ||
| 2745 | - Key URL or ASCII armoured key; and | ||
| 2746 | - Protection preference, one of: \"unprotected\", \"sign\", | ||
| 2747 | \"encrypt\" or \"signencrypt\". | ||
| 2748 | |||
| 2749 | Each of the elements may be nil, in which case its part in the | ||
| 2750 | OpenPGP header will be left out. If all the values are nil, | ||
| 2751 | or `message-openpgp-header' is itself nil, the OpenPGP header | ||
| 2752 | will not be inserted." | ||
| 2753 | :type '(choice | ||
| 2754 | (const nil :tag "Don't add OpenPGP header") | ||
| 2755 | (list (choice (string :tag "ID") | ||
| 2756 | (const nil :tag "No ID")) | ||
| 2757 | (choice (string :tag "Key") | ||
| 2758 | (const nil :tag "No Key")) | ||
| 2759 | (choice (other nil :tag "None") | ||
| 2760 | (const "unprotected" :tag "Unprotected") | ||
| 2761 | (const "sign" :tag "Sign") | ||
| 2762 | (const "encrypt" :tag "Encrypt") | ||
| 2763 | (const "signencrypt" :tag "Sign and Encrypt")))) | ||
| 2764 | :version "28.1") | ||
| 2765 | |||
| 2766 | (defun message-add-openpgp-header () | ||
| 2767 | "Add OpenPGP header to point to public key. | ||
| 2768 | |||
| 2769 | Header will be constructed as specified in `message-openpgp-header'. | ||
| 2770 | |||
| 2771 | Consider adding this function to `message-send-hook'." | ||
| 2772 | ;; See https://tools.ietf.org/html/draft-josefsson-openpgp-mailnews-header | ||
| 2773 | (when (and message-openpgp-header | ||
| 2774 | (or (nth 0 message-openpgp-header) | ||
| 2775 | (nth 1 message-openpgp-header) | ||
| 2776 | (nth 2 message-openpgp-header))) | ||
| 2777 | (with-temp-buffer | ||
| 2778 | (insert "OpenPGP: ") | ||
| 2779 | ;; add ID | ||
| 2780 | (let (need-sep) | ||
| 2781 | (when (nth 0 message-openpgp-header) | ||
| 2782 | (insert "id=" (nth 0 message-openpgp-header)) | ||
| 2783 | (setq need-sep t)) | ||
| 2784 | ;; add URL | ||
| 2785 | (when (nth 1 message-openpgp-header) | ||
| 2786 | (when need-sep (insert "; ")) | ||
| 2787 | (if (string-match-p ";") | ||
| 2788 | (insert "url=\"" (nth 1 message-openpgp-header) "\"") | ||
| 2789 | (insert "url=\"" (nth 1 message-openpgp-header) "\"")) | ||
| 2790 | (setq need-sep t)) | ||
| 2791 | ;; add preference | ||
| 2792 | (when (nth 2 message-openpgp-header) | ||
| 2793 | (when need-sep (insert "; ")) | ||
| 2794 | (insert "preference=" (nth 2 message-openpgp-header)))) | ||
| 2795 | ;; insert header | ||
| 2796 | (message-add-header (buffer-string))))) | ||
| 2797 | |||
| 2733 | 2798 | ||
| 2734 | 2799 | ||
| 2735 | ;;; | 2800 | ;;; |
| @@ -2810,6 +2875,7 @@ systematically send encrypted emails when possible." | |||
| 2810 | (define-key message-mode-map [remap split-line] 'message-split-line) | 2875 | (define-key message-mode-map [remap split-line] 'message-split-line) |
| 2811 | 2876 | ||
| 2812 | (define-key message-mode-map "\C-c\C-a" 'mml-attach-file) | 2877 | (define-key message-mode-map "\C-c\C-a" 'mml-attach-file) |
| 2878 | (define-key message-mode-map "\C-c\C-p" 'message-insert-screenshot) | ||
| 2813 | 2879 | ||
| 2814 | (define-key message-mode-map "\C-a" 'message-beginning-of-line) | 2880 | (define-key message-mode-map "\C-a" 'message-beginning-of-line) |
| 2815 | (define-key message-mode-map "\t" 'message-tab) | 2881 | (define-key message-mode-map "\t" 'message-tab) |
| @@ -2839,6 +2905,8 @@ systematically send encrypted emails when possible." | |||
| 2839 | :active (message-mark-active-p) :help "Mark region with enclosing tags"] | 2905 | :active (message-mark-active-p) :help "Mark region with enclosing tags"] |
| 2840 | ["Insert File Marked..." message-mark-insert-file | 2906 | ["Insert File Marked..." message-mark-insert-file |
| 2841 | :help "Insert file at point marked with enclosing tags"] | 2907 | :help "Insert file at point marked with enclosing tags"] |
| 2908 | ["Attach File..." mml-attach-file t] | ||
| 2909 | ["Insert Screenshot" message-insert-screenshot t] | ||
| 2842 | "----" | 2910 | "----" |
| 2843 | ["Send Message" message-send-and-exit :help "Send this message"] | 2911 | ["Send Message" message-send-and-exit :help "Send this message"] |
| 2844 | ["Postpone Message" message-dont-send | 2912 | ["Postpone Message" message-dont-send |
| @@ -6988,15 +7056,28 @@ want to get rid of this query permanently."))) | |||
| 6988 | 7056 | ||
| 6989 | ;; Build the header alist. Allow the user to be asked whether | 7057 | ;; Build the header alist. Allow the user to be asked whether |
| 6990 | ;; or not to reply to all recipients in a wide reply. | 7058 | ;; or not to reply to all recipients in a wide reply. |
| 6991 | (setq follow-to (list (cons 'To (cdr (pop recipients))))) | 7059 | (when (or (< (length recipients) 2) |
| 6992 | (when (and recipients | 7060 | (not message-wide-reply-confirm-recipients) |
| 6993 | (or (not message-wide-reply-confirm-recipients) | 7061 | (y-or-n-p "Reply to all recipients? ")) |
| 6994 | (y-or-n-p "Reply to all recipients? "))) | 7062 | (if never-mct |
| 6995 | (setq recipients (mapconcat | 7063 | ;; The author has requested never to get a (wide) |
| 6996 | (lambda (addr) (cdr addr)) recipients ", ")) | 7064 | ;; response, so put everybody else into the To header. |
| 6997 | (if (string-match "^ +" recipients) | 7065 | ;; This avoids looking as if we're To-in somebody else in |
| 6998 | (setq recipients (substring recipients (match-end 0)))) | 7066 | ;; specific, and just Cc-in the rest. |
| 6999 | (push (cons 'Cc recipients) follow-to))) | 7067 | (setq follow-to (list |
| 7068 | (cons 'To | ||
| 7069 | (mapconcat | ||
| 7070 | (lambda (addr) | ||
| 7071 | (cdr addr)) recipients ", ")))) | ||
| 7072 | ;; Put the first recipient in the To header. | ||
| 7073 | (setq follow-to (list (cons 'To (cdr (pop recipients))))) | ||
| 7074 | ;; Put the rest of the recipients in Cc. | ||
| 7075 | (when recipients | ||
| 7076 | (setq recipients (mapconcat | ||
| 7077 | (lambda (addr) (cdr addr)) recipients ", ")) | ||
| 7078 | (if (string-match "^ +" recipients) | ||
| 7079 | (setq recipients (substring recipients (match-end 0)))) | ||
| 7080 | (push (cons 'Cc recipients) follow-to))))) | ||
| 7000 | follow-to)) | 7081 | follow-to)) |
| 7001 | 7082 | ||
| 7002 | (defun message-prune-recipients (recipients) | 7083 | (defun message-prune-recipients (recipients) |
| @@ -8652,6 +8733,108 @@ Used in `message-simplify-recipients'." | |||
| 8652 | (* 0.5 (- (nth 3 edges) (nth 1 edges))))) | 8733 | (* 0.5 (- (nth 3 edges) (nth 1 edges))))) |
| 8653 | string))))))) | 8734 | string))))))) |
| 8654 | 8735 | ||
| 8736 | (defun message-insert-screenshot (delay) | ||
| 8737 | "Take a screenshot and insert in the current buffer. | ||
| 8738 | DELAY (the numeric prefix) says how many seconds to wait before | ||
| 8739 | starting the screenshotting process. | ||
| 8740 | |||
| 8741 | The `message-screenshot-command' variable says what command is | ||
| 8742 | used to take the screenshot." | ||
| 8743 | (interactive "p") | ||
| 8744 | (unless (executable-find (car message-screenshot-command)) | ||
| 8745 | (error "Can't find %s to take the screenshot" | ||
| 8746 | (car message-screenshot-command))) | ||
| 8747 | (cl-decf delay) | ||
| 8748 | (unless (zerop delay) | ||
| 8749 | (dotimes (i delay) | ||
| 8750 | (message "Sleeping %d second%s..." | ||
| 8751 | (- delay i) | ||
| 8752 | (if (= (- delay i) 1) | ||
| 8753 | "" | ||
| 8754 | "s")) | ||
| 8755 | (sleep-for 1))) | ||
| 8756 | (message "Take screenshot") | ||
| 8757 | (let ((image | ||
| 8758 | (with-temp-buffer | ||
| 8759 | (set-buffer-multibyte nil) | ||
| 8760 | (apply #'call-process | ||
| 8761 | (car message-screenshot-command) nil (current-buffer) nil | ||
| 8762 | (cdr message-screenshot-command)) | ||
| 8763 | (buffer-string)))) | ||
| 8764 | (set-mark (point)) | ||
| 8765 | (insert-image | ||
| 8766 | (create-image image 'png t | ||
| 8767 | :max-width (truncate (* (frame-pixel-width) 0.8)) | ||
| 8768 | :max-height (truncate (* (frame-pixel-height) 0.8)) | ||
| 8769 | :scale 1) | ||
| 8770 | (format "<#part type=\"image/png\" disposition=inline data-encoding=base64 raw=t>\n%s\n<#/part>" | ||
| 8771 | ;; Get a base64 version of the image -- this avoids later | ||
| 8772 | ;; complications if we're auto-saving the buffer and | ||
| 8773 | ;; restoring from a file. | ||
| 8774 | (with-temp-buffer | ||
| 8775 | (set-buffer-multibyte nil) | ||
| 8776 | (insert image) | ||
| 8777 | (base64-encode-region (point-min) (point-max) t) | ||
| 8778 | (buffer-string)))) | ||
| 8779 | (insert "\n\n") | ||
| 8780 | (message ""))) | ||
| 8781 | |||
| 8782 | (declare-function gnus-url-unhex-string "gnus-util") | ||
| 8783 | |||
| 8784 | (defun message-parse-mailto-url (url) | ||
| 8785 | "Parse a mailto: url." | ||
| 8786 | (setq url (replace-regexp-in-string "\n" " " url)) | ||
| 8787 | (when (string-match "mailto:/*\\(.*\\)" url) | ||
| 8788 | (setq url (substring url (match-beginning 1) nil))) | ||
| 8789 | (setq url (if (string-match "^\\?" url) | ||
| 8790 | (substring url 1) | ||
| 8791 | (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url) | ||
| 8792 | (concat "to=" (match-string 1 url) "&" | ||
| 8793 | (match-string 2 url)) | ||
| 8794 | (concat "to=" url)))) | ||
| 8795 | (let (retval pairs cur key val) | ||
| 8796 | (setq pairs (split-string url "&")) | ||
| 8797 | (while pairs | ||
| 8798 | (setq cur (car pairs) | ||
| 8799 | pairs (cdr pairs)) | ||
| 8800 | (if (not (string-match "=" cur)) | ||
| 8801 | nil ; Grace | ||
| 8802 | (setq key (downcase (gnus-url-unhex-string | ||
| 8803 | (substring cur 0 (match-beginning 0)))) | ||
| 8804 | val (gnus-url-unhex-string (substring cur (match-end 0) nil) t)) | ||
| 8805 | (setq cur (assoc key retval)) | ||
| 8806 | (if cur | ||
| 8807 | (setcdr cur (cons val (cdr cur))) | ||
| 8808 | (setq retval (cons (list key val) retval))))) | ||
| 8809 | retval)) | ||
| 8810 | |||
| 8811 | ;;;###autoload | ||
| 8812 | (defun message-mailto () | ||
| 8813 | "Command to parse command line mailto: links. | ||
| 8814 | This is meant to be used for MIME handlers: Setting the handler | ||
| 8815 | for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\" | ||
| 8816 | will then start up Emacs ready to compose mail." | ||
| 8817 | (interactive) | ||
| 8818 | ;; <a href="mailto:someone@example.com?subject=This%20is%20the%20subject&cc=someone_else@example.com&body=This%20is%20the%20body">Send email</a> | ||
| 8819 | (message-mail) | ||
| 8820 | (message-mailto-1 (pop command-line-args-left))) | ||
| 8821 | |||
| 8822 | (defun message-mailto-1 (url) | ||
| 8823 | (let ((args (message-parse-mailto-url url))) | ||
| 8824 | (dolist (arg args) | ||
| 8825 | (unless (equal (car arg) "body") | ||
| 8826 | (message-position-on-field (capitalize (car arg))) | ||
| 8827 | (insert (replace-regexp-in-string | ||
| 8828 | "\r\n" "\n" | ||
| 8829 | (mapconcat #'identity (reverse (cdr arg)) ", ") nil t)))) | ||
| 8830 | (when (assoc "body" args) | ||
| 8831 | (message-goto-body) | ||
| 8832 | (dolist (body (cdr (assoc "body" args))) | ||
| 8833 | (insert body "\n"))) | ||
| 8834 | (if (assoc "subject" args) | ||
| 8835 | (message-goto-body) | ||
| 8836 | (message-goto-subject)))) | ||
| 8837 | |||
| 8655 | (provide 'message) | 8838 | (provide 'message) |
| 8656 | 8839 | ||
| 8657 | (run-hooks 'message-load-hook) | 8840 | (run-hooks 'message-load-hook) |
diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 587c4e01b92..7f8ab5f9ef5 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el | |||
| @@ -1680,6 +1680,12 @@ If RECURSIVE, search recursively." | |||
| 1680 | (t (y-or-n-p | 1680 | (t (y-or-n-p |
| 1681 | (format "Decrypt (S/MIME) part? ")))) | 1681 | (format "Decrypt (S/MIME) part? ")))) |
| 1682 | (mm-view-pkcs7 parts from)) | 1682 | (mm-view-pkcs7 parts from)) |
| 1683 | (goto-char (point-min)) | ||
| 1684 | ;; The encrypted document is a MIME part, and may use either | ||
| 1685 | ;; CRLF (Outlook and the like) or newlines for end-of-line | ||
| 1686 | ;; markers. Translate from CRLF. | ||
| 1687 | (while (search-forward "\r\n" nil t) | ||
| 1688 | (replace-match "\n")) | ||
| 1683 | ;; Normally there will be a Content-type header here, but | 1689 | ;; Normally there will be a Content-type header here, but |
| 1684 | ;; some mailers don't add that to the encrypted part, which | 1690 | ;; some mailers don't add that to the encrypted part, which |
| 1685 | ;; makes the subsequent re-dissection fail here. | 1691 | ;; makes the subsequent re-dissection fail here. |
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 828ac633dc5..bd5960c18b2 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el | |||
| @@ -59,11 +59,16 @@ | |||
| 59 | "The attributes of renderer types for text/html.") | 59 | "The attributes of renderer types for text/html.") |
| 60 | 60 | ||
| 61 | (defcustom mm-fill-flowed t | 61 | (defcustom mm-fill-flowed t |
| 62 | "If non-nil a format=flowed article will be displayed flowed." | 62 | "If non-nil, format=flowed articles will be displayed flowed." |
| 63 | :type 'boolean | 63 | :type 'boolean |
| 64 | :version "22.1" | 64 | :version "22.1" |
| 65 | :group 'mime-display) | 65 | :group 'mime-display) |
| 66 | 66 | ||
| 67 | ;; Not a defcustom, since it's usually overridden by the callers of | ||
| 68 | ;; the mm functions. | ||
| 69 | (defvar mm-inline-font-lock t | ||
| 70 | "If non-nil, do font locking of inline media types that support it.") | ||
| 71 | |||
| 67 | (defcustom mm-inline-large-images-proportion 0.9 | 72 | (defcustom mm-inline-large-images-proportion 0.9 |
| 68 | "Maximum proportion large images can occupy in the buffer. | 73 | "Maximum proportion large images can occupy in the buffer. |
| 69 | This is only used if `mm-inline-large-images' is set to | 74 | This is only used if `mm-inline-large-images' is set to |
| @@ -502,7 +507,8 @@ If MODE is not set, try to find mode automatically." | |||
| 502 | (delay-mode-hooks (set-auto-mode)) | 507 | (delay-mode-hooks (set-auto-mode)) |
| 503 | (setq mode major-mode))) | 508 | (setq mode major-mode))) |
| 504 | ;; Do not fontify if the guess mode is fundamental. | 509 | ;; Do not fontify if the guess mode is fundamental. |
| 505 | (unless (eq major-mode 'fundamental-mode) | 510 | (when (and (not (eq major-mode 'fundamental-mode)) |
| 511 | mm-inline-font-lock) | ||
| 506 | (font-lock-ensure)))) | 512 | (font-lock-ensure)))) |
| 507 | (setq text (buffer-string)) | 513 | (setq text (buffer-string)) |
| 508 | (when (eq mode 'diff-mode) | 514 | (when (eq mode 'diff-mode) |
diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 740e1d2b722..69852c381d6 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el | |||
| @@ -665,8 +665,9 @@ The passphrase is read and cached." | |||
| 665 | (epg-user-id-string uid)))) | 665 | (epg-user-id-string uid)))) |
| 666 | (equal (downcase (car (mail-header-parse-address | 666 | (equal (downcase (car (mail-header-parse-address |
| 667 | (epg-user-id-string uid)))) | 667 | (epg-user-id-string uid)))) |
| 668 | (downcase (car (mail-header-parse-address | 668 | (downcase (or (car (mail-header-parse-address |
| 669 | recipient)))) | 669 | recipient)) |
| 670 | recipient))) | ||
| 670 | (not (memq (epg-user-id-validity uid) | 671 | (not (memq (epg-user-id-validity uid) |
| 671 | '(revoked expired)))) | 672 | '(revoked expired)))) |
| 672 | (throw 'break t)))))) | 673 | (throw 'break t)))))) |
| @@ -937,6 +938,10 @@ If no one is selected, symmetric encryption will be performed. " | |||
| 937 | (signal (car error) (cdr error)))) | 938 | (signal (car error) (cdr error)))) |
| 938 | cipher)) | 939 | cipher)) |
| 939 | 940 | ||
| 941 | ;; Should probably be removed and the interface should be different. | ||
| 942 | (defvar mml-secure-allow-signing-with-unknown-recipient nil | ||
| 943 | "Variable to bind to allow automatic recipient selection.") | ||
| 944 | |||
| 940 | (defun mml-secure-epg-sign (protocol mode) | 945 | (defun mml-secure-epg-sign (protocol mode) |
| 941 | ;; Based on code appearing inside mml2015-epg-sign. | 946 | ;; Based on code appearing inside mml2015-epg-sign. |
| 942 | (let* ((context (epg-make-context protocol)) | 947 | (let* ((context (epg-make-context protocol)) |
| @@ -953,7 +958,8 @@ If no one is selected, symmetric encryption will be performed. " | |||
| 953 | ;; then there's no point advising the user to examine it. If | 958 | ;; then there's no point advising the user to examine it. If |
| 954 | ;; there are any other variables worth examining, please | 959 | ;; there are any other variables worth examining, please |
| 955 | ;; improve this error message by having it mention them. | 960 | ;; improve this error message by having it mention them. |
| 956 | (error "Couldn't find any signer names%s" maybe-msg))) | 961 | (unless mml-secure-allow-signing-with-unknown-recipient |
| 962 | (error "Couldn't find any signer names%s" maybe-msg)))) | ||
| 957 | (when (eq 'OpenPGP protocol) | 963 | (when (eq 'OpenPGP protocol) |
| 958 | (setf (epg-context-armor context) t) | 964 | (setf (epg-context-armor context) t) |
| 959 | (setf (epg-context-textmode context) t) | 965 | (setf (epg-context-textmode context) t) |
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 21491499eb8..ef8aa6ac019 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el | |||
| @@ -295,6 +295,17 @@ part. This is for the internal use, you should never modify the value.") | |||
| 295 | (t | 295 | (t |
| 296 | (mm-find-mime-charset-region point (point) | 296 | (mm-find-mime-charset-region point (point) |
| 297 | mm-hack-charsets)))) | 297 | mm-hack-charsets)))) |
| 298 | ;; We have a part that already has a transfer encoding. Undo | ||
| 299 | ;; that so that we don't double-encode later. | ||
| 300 | (when (and raw | ||
| 301 | (cdr (assq 'data-encoding tag))) | ||
| 302 | (with-temp-buffer | ||
| 303 | (set-buffer-multibyte nil) | ||
| 304 | (insert contents) | ||
| 305 | (mm-decode-content-transfer-encoding | ||
| 306 | (intern (cdr (assq 'data-encoding tag))) | ||
| 307 | (cdr (assq 'type tag))) | ||
| 308 | (setq contents (buffer-string)))) | ||
| 298 | (when (and (not raw) (memq nil charsets)) | 309 | (when (and (not raw) (memq nil charsets)) |
| 299 | (if (or (memq 'unknown-encoding mml-confirmation-set) | 310 | (if (or (memq 'unknown-encoding mml-confirmation-set) |
| 300 | (message-options-get 'unknown-encoding) | 311 | (message-options-get 'unknown-encoding) |
| @@ -313,8 +324,8 @@ Message contains characters with unknown encoding. Really send? ") | |||
| 313 | (eq 'mml (car tag)) | 324 | (eq 'mml (car tag)) |
| 314 | (< (length charsets) 2)) | 325 | (< (length charsets) 2)) |
| 315 | (if (or (not no-markup-p) | 326 | (if (or (not no-markup-p) |
| 327 | ;; Don't create blank parts. | ||
| 316 | (string-match "[^ \t\r\n]" contents)) | 328 | (string-match "[^ \t\r\n]" contents)) |
| 317 | ;; Don't create blank parts. | ||
| 318 | (push (nconc tag (list (cons 'contents contents))) | 329 | (push (nconc tag (list (cons 'contents contents))) |
| 319 | struct)) | 330 | struct)) |
| 320 | (let ((nstruct (mml-parse-singlepart-with-multiple-charsets | 331 | (let ((nstruct (mml-parse-singlepart-with-multiple-charsets |
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index fe6daf6b037..5500148e518 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el | |||
| @@ -185,6 +185,9 @@ and the files themselves should be in PEM format." | |||
| 185 | :version "22.1" | 185 | :version "22.1" |
| 186 | :type '(choice (const :tag "Triple DES" "-des3") | 186 | :type '(choice (const :tag "Triple DES" "-des3") |
| 187 | (const :tag "DES" "-des") | 187 | (const :tag "DES" "-des") |
| 188 | (const :tag "AES 256 bits" "-aes256") | ||
| 189 | (const :tag "AES 192 bits" "-aes192") | ||
| 190 | (const :tag "AES 128 bits" "-aes128") | ||
| 188 | (const :tag "RC2 40 bits" "-rc2-40") | 191 | (const :tag "RC2 40 bits" "-rc2-40") |
| 189 | (const :tag "RC2 64 bits" "-rc2-64") | 192 | (const :tag "RC2 64 bits" "-rc2-64") |
| 190 | (const :tag "RC2 128 bits" "-rc2-128")) | 193 | (const :tag "RC2 128 bits" "-rc2-128")) |
diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 082a44d9bf5..d40b9286f8e 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el | |||
| @@ -1778,6 +1778,50 @@ documentation for the major and minor modes of that buffer." | |||
| 1778 | ;; For the sake of IELM and maybe others | 1778 | ;; For the sake of IELM and maybe others |
| 1779 | nil) | 1779 | nil) |
| 1780 | 1780 | ||
| 1781 | ;; Widgets. | ||
| 1782 | |||
| 1783 | (defvar describe-widget-functions | ||
| 1784 | '(button-describe widget-describe) | ||
| 1785 | "A list of functions for `describe-widget' to call. | ||
| 1786 | Each function should take one argument, a buffer position, and return | ||
| 1787 | non-nil if it described a widget at that position.") | ||
| 1788 | |||
| 1789 | ;;;###autoload | ||
| 1790 | (defun describe-widget (&optional pos) | ||
| 1791 | "Display a buffer with information about a widget. | ||
| 1792 | You can use this command to describe buttons (e.g., the links in a *Help* | ||
| 1793 | buffer), editable fields of the customization buffers, etc. | ||
| 1794 | |||
| 1795 | Interactively, click on a widget to describe it, or hit RET to describe the | ||
| 1796 | widget at point. | ||
| 1797 | |||
| 1798 | When called from Lisp, POS may be a buffer position or a mouse position list. | ||
| 1799 | |||
| 1800 | Calls each function of the list `describe-widget-functions' in turn, until | ||
| 1801 | one of them returns non-nil." | ||
| 1802 | (interactive | ||
| 1803 | (list | ||
| 1804 | (let ((key | ||
| 1805 | (read-key | ||
| 1806 | "Click on a widget, or hit RET to describe the widget at point"))) | ||
| 1807 | (cond ((eq key ?\C-m) (point)) | ||
| 1808 | ((and (mouse-event-p key) | ||
| 1809 | (eq (event-basic-type key) 'mouse-1) | ||
| 1810 | (equal (event-modifiers key) '(click))) | ||
| 1811 | (event-end key)) | ||
| 1812 | ((eq key ?\C-g) (signal 'quit nil)) | ||
| 1813 | (t (user-error "You didn't specify a widget")))))) | ||
| 1814 | (let (buf) | ||
| 1815 | ;; Allow describing a widget in a different window. | ||
| 1816 | (when (posnp pos) | ||
| 1817 | (setq buf (window-buffer (posn-window pos)) | ||
| 1818 | pos (posn-point pos))) | ||
| 1819 | (with-current-buffer (or buf (current-buffer)) | ||
| 1820 | (unless (cl-some (lambda (fun) (when (fboundp fun) (funcall fun pos))) | ||
| 1821 | describe-widget-functions) | ||
| 1822 | (message "No widget found at that position"))))) | ||
| 1823 | |||
| 1824 | |||
| 1781 | ;;; Replacements for old lib-src/ programs. Don't seem especially useful. | 1825 | ;;; Replacements for old lib-src/ programs. Don't seem especially useful. |
| 1782 | 1826 | ||
| 1783 | ;; Replaces lib-src/digest-doc.c. | 1827 | ;; Replaces lib-src/digest-doc.c. |
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index a18310322ad..33ca40f8dec 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el | |||
| @@ -812,7 +812,9 @@ SPACES-REGEXP is a regexp to substitute spaces in font-lock search." | |||
| 812 | (setq hi-lock-interactive-patterns | 812 | (setq hi-lock-interactive-patterns |
| 813 | (cdr hi-lock-interactive-patterns) | 813 | (cdr hi-lock-interactive-patterns) |
| 814 | hi-lock-interactive-lighters | 814 | hi-lock-interactive-lighters |
| 815 | (cdr hi-lock-interactive-lighters))))))))) | 815 | (cdr hi-lock-interactive-lighters)))) |
| 816 | (when (or (> search-start (point-min)) (< search-end (point-max))) | ||
| 817 | (message "Hi-lock added only in range %d-%d" search-start search-end))))))) | ||
| 816 | 818 | ||
| 817 | (defun hi-lock-set-file-patterns (patterns) | 819 | (defun hi-lock-set-file-patterns (patterns) |
| 818 | "Replace file patterns list with PATTERNS and refontify." | 820 | "Replace file patterns list with PATTERNS and refontify." |
diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index bfb9787a96d..c9ca1f87424 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el | |||
| @@ -504,7 +504,7 @@ format. See `ibuffer-update-saved-filters-format' and | |||
| 504 | (ibuffer-forward-line 0)) | 504 | (ibuffer-forward-line 0)) |
| 505 | 505 | ||
| 506 | (defun ibuffer--maybe-erase-shell-cmd-output () | 506 | (defun ibuffer--maybe-erase-shell-cmd-output () |
| 507 | (let ((buf (get-buffer "*Shell Command Output*"))) | 507 | (let ((buf (get-buffer shell-command-buffer-name))) |
| 508 | (when (and (buffer-live-p buf) | 508 | (when (and (buffer-live-p buf) |
| 509 | (not shell-command-dont-erase-buffer) | 509 | (not shell-command-dont-erase-buffer) |
| 510 | (not (zerop (buffer-size buf)))) | 510 | (not (zerop (buffer-size buf)))) |
| @@ -517,7 +517,7 @@ format. See `ibuffer-update-saved-filters-format' and | |||
| 517 | :opstring "Shell command executed on" | 517 | :opstring "Shell command executed on" |
| 518 | :before (ibuffer--maybe-erase-shell-cmd-output) | 518 | :before (ibuffer--maybe-erase-shell-cmd-output) |
| 519 | :modifier-p nil) | 519 | :modifier-p nil) |
| 520 | (let ((out-buf (get-buffer-create "*Shell Command Output*"))) | 520 | (let ((out-buf (get-buffer-create shell-command-buffer-name))) |
| 521 | (with-current-buffer out-buf (goto-char (point-max))) | 521 | (with-current-buffer out-buf (goto-char (point-max))) |
| 522 | (call-shell-region (point-min) (point-max) | 522 | (call-shell-region (point-min) (point-max) |
| 523 | command nil out-buf))) | 523 | command nil out-buf))) |
| @@ -542,7 +542,7 @@ format. See `ibuffer-update-saved-filters-format' and | |||
| 542 | :modifier-p nil) | 542 | :modifier-p nil) |
| 543 | (let ((file (and (not (buffer-modified-p)) | 543 | (let ((file (and (not (buffer-modified-p)) |
| 544 | buffer-file-name)) | 544 | buffer-file-name)) |
| 545 | (out-buf (get-buffer-create "*Shell Command Output*"))) | 545 | (out-buf (get-buffer-create shell-command-buffer-name))) |
| 546 | (unless (and file (file-exists-p file)) | 546 | (unless (and file (file-exists-p file)) |
| 547 | (setq file | 547 | (setq file |
| 548 | (make-temp-file | 548 | (make-temp-file |
diff --git a/lisp/image-file.el b/lisp/image-file.el index 89cd75d50dd..22366c89e6a 100644 --- a/lisp/image-file.el +++ b/lisp/image-file.el | |||
| @@ -32,6 +32,7 @@ | |||
| 32 | ;;; Code: | 32 | ;;; Code: |
| 33 | 33 | ||
| 34 | (require 'image) | 34 | (require 'image) |
| 35 | (require 'image-converter) | ||
| 35 | 36 | ||
| 36 | 37 | ||
| 37 | ;;;###autoload | 38 | ;;;###autoload |
| @@ -80,10 +81,13 @@ the variable is set using \\[customize]." | |||
| 80 | (let ((exts-regexp | 81 | (let ((exts-regexp |
| 81 | (and image-file-name-extensions | 82 | (and image-file-name-extensions |
| 82 | (concat "\\." | 83 | (concat "\\." |
| 83 | (regexp-opt (nconc (mapcar #'upcase | 84 | (regexp-opt |
| 84 | image-file-name-extensions) | 85 | (append (mapcar #'upcase image-file-name-extensions) |
| 85 | image-file-name-extensions) | 86 | image-file-name-extensions |
| 86 | t) | 87 | (mapcar #'upcase |
| 88 | image-converter-file-name-extensions) | ||
| 89 | image-converter-file-name-extensions) | ||
| 90 | t) | ||
| 87 | "\\'")))) | 91 | "\\'")))) |
| 88 | (mapconcat | 92 | (mapconcat |
| 89 | 'identity | 93 | 'identity |
diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 1bb213c2489..948e62e10d0 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el | |||
| @@ -40,6 +40,7 @@ | |||
| 40 | 40 | ||
| 41 | (require 'image) | 41 | (require 'image) |
| 42 | (require 'exif) | 42 | (require 'exif) |
| 43 | (require 'dired) | ||
| 43 | (eval-when-compile (require 'cl-lib)) | 44 | (eval-when-compile (require 'cl-lib)) |
| 44 | 45 | ||
| 45 | ;;; Image mode window-info management. | 46 | ;;; Image mode window-info management. |
| @@ -614,21 +615,23 @@ Key bindings: | |||
| 614 | (if (not (image-get-display-property)) | 615 | (if (not (image-get-display-property)) |
| 615 | (progn | 616 | (progn |
| 616 | (when (condition-case err | 617 | (when (condition-case err |
| 617 | (progn | 618 | (progn |
| 618 | (image-toggle-display-image) | 619 | (image-toggle-display-image) |
| 619 | t) | 620 | t) |
| 620 | (unknown-image-type | 621 | (unknown-image-type |
| 621 | (image-mode-as-text) | 622 | (image-mode-as-text) |
| 622 | (funcall | 623 | (funcall |
| 623 | (if (called-interactively-p 'any) 'error 'message) | 624 | (if (called-interactively-p 'any) 'error 'message) |
| 624 | "Unknown image type; consider switching `image-use-external-converter' on") | 625 | (if image-use-external-converter |
| 625 | nil) | 626 | "Unknown image type" |
| 626 | (error | 627 | "Unknown image type; consider switching `image-use-external-converter' on")) |
| 627 | (image-mode-as-text) | 628 | nil) |
| 628 | (funcall | 629 | (error |
| 629 | (if (called-interactively-p 'any) 'error 'message) | 630 | (image-mode-as-text) |
| 630 | "Cannot display image: %s" (cdr err)) | 631 | (funcall |
| 631 | nil)) | 632 | (if (called-interactively-p 'any) 'error 'message) |
| 633 | "Cannot display image: %s" (cdr err)) | ||
| 634 | nil)) | ||
| 632 | ;; If attempt to display the image fails. | 635 | ;; If attempt to display the image fails. |
| 633 | (if (not (image-get-display-property)) | 636 | (if (not (image-get-display-property)) |
| 634 | (error "Invalid image")) | 637 | (error "Invalid image")) |
| @@ -816,13 +819,21 @@ was inserted." | |||
| 816 | (- (nth 2 edges) (nth 0 edges)))) | 819 | (- (nth 2 edges) (nth 0 edges)))) |
| 817 | (max-height (when edges | 820 | (max-height (when edges |
| 818 | (- (nth 3 edges) (nth 1 edges)))) | 821 | (- (nth 3 edges) (nth 1 edges)))) |
| 819 | (type (if (image--imagemagick-wanted-p filename) | ||
| 820 | 'imagemagick | ||
| 821 | (image-type file-or-data nil data-p))) | ||
| 822 | (inhibit-read-only t) | 822 | (inhibit-read-only t) |
| 823 | (buffer-undo-list t) | 823 | (buffer-undo-list t) |
| 824 | (modified (buffer-modified-p)) | 824 | (modified (buffer-modified-p)) |
| 825 | props image) | 825 | props image type) |
| 826 | |||
| 827 | ;; If the data in the current buffer isn't from an existing file, | ||
| 828 | ;; but we have a file name (this happens when visiting images from | ||
| 829 | ;; a zip file, for instance), provide a type hint based on the | ||
| 830 | ;; suffix. | ||
| 831 | (when (and data-p filename) | ||
| 832 | (setq data-p (intern (format "image/%s" | ||
| 833 | (file-name-extension filename))))) | ||
| 834 | (setq type (if (image--imagemagick-wanted-p filename) | ||
| 835 | 'imagemagick | ||
| 836 | (image-type file-or-data nil data-p))) | ||
| 826 | 837 | ||
| 827 | ;; Get the rotation data from the file, if any. | 838 | ;; Get the rotation data from the file, if any. |
| 828 | (when (zerop image-transform-rotation) ; don't reset modified value | 839 | (when (zerop image-transform-rotation) ; don't reset modified value |
| @@ -839,10 +850,13 @@ was inserted." | |||
| 839 | ;; :scale 1: If we do not set this, create-image will apply | 850 | ;; :scale 1: If we do not set this, create-image will apply |
| 840 | ;; default scaling based on font size. | 851 | ;; default scaling based on font size. |
| 841 | (setq image (if (not edges) | 852 | (setq image (if (not edges) |
| 842 | (create-image file-or-data type data-p :scale 1) | 853 | (create-image file-or-data type data-p :scale 1 |
| 854 | :format (and filename data-p)) | ||
| 843 | (create-image file-or-data type data-p :scale 1 | 855 | (create-image file-or-data type data-p :scale 1 |
| 844 | :max-width max-width | 856 | :max-width max-width |
| 845 | :max-height max-height))) | 857 | :max-height max-height |
| 858 | ;; Type hint. | ||
| 859 | :format (and filename data-p)))) | ||
| 846 | 860 | ||
| 847 | ;; Discard any stale image data before looking it up again. | 861 | ;; Discard any stale image data before looking it up again. |
| 848 | (image-flush image) | 862 | (image-flush image) |
| @@ -1072,28 +1086,87 @@ replacing the current Image mode buffer." | |||
| 1072 | (error "The buffer is not in Image mode")) | 1086 | (error "The buffer is not in Image mode")) |
| 1073 | (unless buffer-file-name | 1087 | (unless buffer-file-name |
| 1074 | (error "The current image is not associated with a file")) | 1088 | (error "The current image is not associated with a file")) |
| 1075 | (let* ((file (file-name-nondirectory buffer-file-name)) | 1089 | (let ((next (image-mode--next-file buffer-file-name n))) |
| 1076 | (images (image-mode--images-in-directory file)) | 1090 | (unless next |
| 1077 | (idx 0)) | 1091 | (user-error "No %s file in this directory" |
| 1078 | (catch 'image-visit-next-file | 1092 | (if (> n 0) |
| 1079 | (dolist (f images) | 1093 | "next" |
| 1080 | (if (string= f file) | 1094 | "prev"))) |
| 1081 | (throw 'image-visit-next-file (1+ idx))) | 1095 | (if (stringp next) |
| 1082 | (setq idx (1+ idx)))) | 1096 | (find-alternate-file next) |
| 1083 | (setq idx (mod (+ idx (or n 1)) (length images))) | 1097 | (funcall next)))) |
| 1084 | (let ((image (nth idx images)) | 1098 | |
| 1085 | (dir (file-name-directory buffer-file-name))) | 1099 | (defun image-mode--directory-buffers (file) |
| 1086 | (find-alternate-file image) | 1100 | "Return a alist of type/buffer for all \"parent\" buffers to image FILE. |
| 1087 | ;; If we have dired buffer(s) open to where this image is, then | 1101 | This is normally a list of dired buffers, but can also be archive and |
| 1088 | ;; place point on it. | 1102 | tar mode buffers." |
| 1103 | (let ((buffers nil) | ||
| 1104 | (dir (file-name-directory file))) | ||
| 1105 | (cond | ||
| 1106 | ((and (boundp 'tar-superior-buffer) | ||
| 1107 | tar-superior-buffer) | ||
| 1108 | (when (buffer-live-p tar-superior-buffer) | ||
| 1109 | (push (cons 'tar tar-superior-buffer) buffers))) | ||
| 1110 | ((and (boundp 'archive-superior-buffer) | ||
| 1111 | archive-superior-buffer) | ||
| 1112 | (when (buffer-live-p archive-superior-buffer) | ||
| 1113 | (push (cons 'archive archive-superior-buffer) buffers))) | ||
| 1114 | (t | ||
| 1115 | ;; Find a dired buffer. | ||
| 1089 | (dolist (buffer (buffer-list)) | 1116 | (dolist (buffer (buffer-list)) |
| 1090 | (with-current-buffer buffer | 1117 | (with-current-buffer buffer |
| 1091 | (when (and (derived-mode-p 'dired-mode) | 1118 | (when (and (derived-mode-p 'dired-mode) |
| 1092 | (equal (file-truename dir) | 1119 | (equal (file-truename dir) |
| 1093 | (file-truename default-directory))) | 1120 | (file-truename default-directory))) |
| 1094 | (save-window-excursion | 1121 | (push (cons 'dired (current-buffer)) buffers)))) |
| 1095 | (switch-to-buffer (current-buffer) t t) | 1122 | ;; If we can't find any buffers to navigate in, we open a dired |
| 1096 | (dired-goto-file (expand-file-name image dir))))))))) | 1123 | ;; buffer. |
| 1124 | (unless buffers | ||
| 1125 | (push (cons 'dired (find-file-noselect dir)) buffers) | ||
| 1126 | (message "Opened a dired buffer on %s" dir)))) | ||
| 1127 | buffers)) | ||
| 1128 | |||
| 1129 | (declare-function archive-next-file-displayer "arc-mode") | ||
| 1130 | (declare-function tar-next-file-displayer "tar-mode") | ||
| 1131 | |||
| 1132 | (defun image-mode--next-file (file n) | ||
| 1133 | "Go to the next image file in the parent buffer of FILE. | ||
| 1134 | This is typically a dired buffer, but may also be a tar/archive buffer. | ||
| 1135 | Return the next image file from that buffer. | ||
| 1136 | If N is negative, go to the previous file." | ||
| 1137 | (let ((regexp (image-file-name-regexp)) | ||
| 1138 | (buffers (image-mode--directory-buffers file)) | ||
| 1139 | next) | ||
| 1140 | (dolist (buffer buffers) | ||
| 1141 | ;; We do this traversal for all the dired buffers open on this | ||
| 1142 | ;; directory. There probably is just one, but we want to move | ||
| 1143 | ;; point in all of them. | ||
| 1144 | (save-window-excursion | ||
| 1145 | (switch-to-buffer (cdr buffer) t t) | ||
| 1146 | (cl-case (car buffer) | ||
| 1147 | ('dired | ||
| 1148 | (dired-goto-file file) | ||
| 1149 | (let (found) | ||
| 1150 | (while (and (not found) | ||
| 1151 | ;; Stop if we reach the end/start of the buffer. | ||
| 1152 | (if (> n 0) | ||
| 1153 | (not (eobp)) | ||
| 1154 | (not (bobp)))) | ||
| 1155 | (dired-next-line n) | ||
| 1156 | (let ((candidate (dired-get-filename nil t))) | ||
| 1157 | (when (and candidate | ||
| 1158 | (string-match-p regexp candidate)) | ||
| 1159 | (setq found candidate)))) | ||
| 1160 | (if found | ||
| 1161 | (setq next found) | ||
| 1162 | ;; If we didn't find a next/prev file, then restore | ||
| 1163 | ;; point. | ||
| 1164 | (dired-goto-file file)))) | ||
| 1165 | ('archive | ||
| 1166 | (setq next (archive-next-file-displayer file regexp n))) | ||
| 1167 | ('tar | ||
| 1168 | (setq next (tar-next-file-displayer file regexp n)))))) | ||
| 1169 | next)) | ||
| 1097 | 1170 | ||
| 1098 | (defun image-previous-file (&optional n) | 1171 | (defun image-previous-file (&optional n) |
| 1099 | "Visit the preceding image in the same directory as the current file. | 1172 | "Visit the preceding image in the same directory as the current file. |
diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el index b694052f5b9..ee1dc845fb5 100644 --- a/lisp/image/image-converter.el +++ b/lisp/image/image-converter.el | |||
| @@ -42,6 +42,9 @@ installed on the system." | |||
| 42 | (defvar image-converter-regexp nil | 42 | (defvar image-converter-regexp nil |
| 43 | "A regexp that matches the file name suffixes that can be converted.") | 43 | "A regexp that matches the file name suffixes that can be converted.") |
| 44 | 44 | ||
| 45 | (defvar image-converter-file-name-extensions nil | ||
| 46 | "A list of file name suffixes that can be converted.") | ||
| 47 | |||
| 45 | (defvar image-converter--converters | 48 | (defvar image-converter--converters |
| 46 | '((graphicsmagick :command ("gm" "convert") :probe ("-list" "format")) | 49 | '((graphicsmagick :command ("gm" "convert") :probe ("-list" "format")) |
| 47 | (ffmpeg :command "ffmpeg" :probe "-decoders") | 50 | (ffmpeg :command "ffmpeg" :probe "-decoders") |
| @@ -58,9 +61,11 @@ is a string, it should be a MIME format string like | |||
| 58 | (unless image-converter | 61 | (unless image-converter |
| 59 | (image-converter--find-converter)) | 62 | (image-converter--find-converter)) |
| 60 | ;; When image-converter was customized | 63 | ;; When image-converter was customized |
| 61 | (if (and image-converter (not image-converter-regexp)) | 64 | (when (and image-converter (not image-converter-regexp)) |
| 62 | (when-let ((formats (image-converter--probe image-converter))) | 65 | (when-let ((formats (image-converter--probe image-converter))) |
| 63 | (setq image-converter-regexp (concat "\\." (regexp-opt formats) "\\'")))) | 66 | (setq image-converter-regexp |
| 67 | (concat "\\." (regexp-opt formats) "\\'")) | ||
| 68 | (setq image-converter-file-name-extensions formats))) | ||
| 64 | (and image-converter | 69 | (and image-converter |
| 65 | (or (and (not data-p) | 70 | (or (and (not data-p) |
| 66 | (string-match image-converter-regexp source)) | 71 | (string-match image-converter-regexp source)) |
| @@ -183,7 +188,8 @@ data is returned as a string." | |||
| 183 | (dolist (elem image-converter--converters) | 188 | (dolist (elem image-converter--converters) |
| 184 | (when-let ((formats (image-converter--probe (car elem)))) | 189 | (when-let ((formats (image-converter--probe (car elem)))) |
| 185 | (setq image-converter (car elem) | 190 | (setq image-converter (car elem) |
| 186 | image-converter-regexp (concat "\\." (regexp-opt formats) "\\'")) | 191 | image-converter-regexp (concat "\\." (regexp-opt formats) "\\'") |
| 192 | image-converter-file-name-extensions formats) | ||
| 187 | (throw 'done image-converter))))) | 193 | (throw 'done image-converter))))) |
| 188 | 194 | ||
| 189 | (cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source | 195 | (cl-defmethod image-converter--convert ((type (eql graphicsmagick)) source |
diff --git a/lisp/international/ja-dic-cnv.el b/lisp/international/ja-dic-cnv.el index 45e13462656..f5e70ce7021 100644 --- a/lisp/international/ja-dic-cnv.el +++ b/lisp/international/ja-dic-cnv.el | |||
| @@ -48,7 +48,7 @@ | |||
| 48 | (defvar ja-dic-filename "ja-dic.el") | 48 | (defvar ja-dic-filename "ja-dic.el") |
| 49 | 49 | ||
| 50 | (defun skkdic-convert-okuri-ari (skkbuf buf) | 50 | (defun skkdic-convert-okuri-ari (skkbuf buf) |
| 51 | (byte-compile-info-message "Processing OKURI-ARI entries") | 51 | (byte-compile-info "Processing OKURI-ARI entries" t) |
| 52 | (goto-char (point-min)) | 52 | (goto-char (point-min)) |
| 53 | (with-current-buffer buf | 53 | (with-current-buffer buf |
| 54 | (insert ";; Setting okuri-ari entries.\n" | 54 | (insert ";; Setting okuri-ari entries.\n" |
| @@ -97,7 +97,7 @@ | |||
| 97 | ("ゆき" "行"))) | 97 | ("ゆき" "行"))) |
| 98 | 98 | ||
| 99 | (defun skkdic-convert-postfix (skkbuf buf) | 99 | (defun skkdic-convert-postfix (skkbuf buf) |
| 100 | (byte-compile-info-message "Processing POSTFIX entries") | 100 | (byte-compile-info "Processing POSTFIX entries" t) |
| 101 | (goto-char (point-min)) | 101 | (goto-char (point-min)) |
| 102 | (with-current-buffer buf | 102 | (with-current-buffer buf |
| 103 | (insert ";; Setting postfix entries.\n" | 103 | (insert ";; Setting postfix entries.\n" |
| @@ -151,7 +151,7 @@ | |||
| 151 | (defconst skkdic-prefix-list '(skkdic-prefix-list)) | 151 | (defconst skkdic-prefix-list '(skkdic-prefix-list)) |
| 152 | 152 | ||
| 153 | (defun skkdic-convert-prefix (skkbuf buf) | 153 | (defun skkdic-convert-prefix (skkbuf buf) |
| 154 | (byte-compile-info-message "Processing PREFIX entries") | 154 | (byte-compile-info "Processing PREFIX entries" t) |
| 155 | (goto-char (point-min)) | 155 | (goto-char (point-min)) |
| 156 | (with-current-buffer buf | 156 | (with-current-buffer buf |
| 157 | (insert ";; Setting prefix entries.\n" | 157 | (insert ";; Setting prefix entries.\n" |
| @@ -273,7 +273,7 @@ | |||
| 273 | (defun skkdic-collect-okuri-nasi () | 273 | (defun skkdic-collect-okuri-nasi () |
| 274 | (save-excursion | 274 | (save-excursion |
| 275 | (let ((progress (make-progress-reporter | 275 | (let ((progress (make-progress-reporter |
| 276 | (byte-compile-info-message "Collecting OKURI-NASI entries") | 276 | (byte-compile-info "Collecting OKURI-NASI entries" t) |
| 277 | (point) (point-max) | 277 | (point) (point-max) |
| 278 | nil 10))) | 278 | nil 10))) |
| 279 | (while (re-search-forward "^\\(\\cH+\\) \\(/\\cj.*\\)/$" | 279 | (while (re-search-forward "^\\(\\cH+\\) \\(/\\cj.*\\)/$" |
| @@ -301,7 +301,7 @@ | |||
| 301 | "(skkdic-set-okuri-nasi\n") | 301 | "(skkdic-set-okuri-nasi\n") |
| 302 | (let ((l (nreverse skkdic-okuri-nasi-entries)) | 302 | (let ((l (nreverse skkdic-okuri-nasi-entries)) |
| 303 | (progress (make-progress-reporter | 303 | (progress (make-progress-reporter |
| 304 | (byte-compile-info-message "Processing OKURI-NASI entries") | 304 | (byte-compile-info "Processing OKURI-NASI entries" t) |
| 305 | 0 skkdic-okuri-nasi-entries-count | 305 | 0 skkdic-okuri-nasi-entries-count |
| 306 | nil 10)) | 306 | nil 10)) |
| 307 | (count 0)) | 307 | (count 0)) |
| @@ -531,8 +531,7 @@ To get complete usage, invoke: | |||
| 531 | ',(let ((l entries) | 531 | ',(let ((l entries) |
| 532 | (map '(skdic-okuri-nasi)) | 532 | (map '(skdic-okuri-nasi)) |
| 533 | (progress (make-progress-reporter | 533 | (progress (make-progress-reporter |
| 534 | (byte-compile-info-message | 534 | (byte-compile-info "Extracting OKURI-NASI entries") |
| 535 | "Extracting OKURI-NASI entries") | ||
| 536 | 0 (length entries))) | 535 | 0 (length entries))) |
| 537 | (count 0) | 536 | (count 0) |
| 538 | entry) | 537 | entry) |
diff --git a/lisp/mouse.el b/lisp/mouse.el index 640f10af4e1..d369545f18e 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el | |||
| @@ -49,7 +49,10 @@ | |||
| 49 | "If non-nil, copy to kill-ring upon mouse adjustments of the region. | 49 | "If non-nil, copy to kill-ring upon mouse adjustments of the region. |
| 50 | 50 | ||
| 51 | This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in | 51 | This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in |
| 52 | addition to mouse drags." | 52 | addition to mouse drags. |
| 53 | |||
| 54 | This variable applies only to mouse adjustments in Emacs, not | ||
| 55 | selecting and adjusting regions in other windows." | ||
| 53 | :type 'boolean | 56 | :type 'boolean |
| 54 | :version "24.1") | 57 | :version "24.1") |
| 55 | 58 | ||
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 8892e800cd6..2b8d4d0ce62 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; browse-url.el --- pass a URL to a WWW browser | 1 | ;;; browse-url.el --- pass a URL to a WWW browser -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1995-2020 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1995-2020 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -425,25 +425,6 @@ Passing an interactive argument to \\[browse-url], or specific browser | |||
| 425 | commands reverses the effect of this variable." | 425 | commands reverses the effect of this variable." |
| 426 | :type 'boolean) | 426 | :type 'boolean) |
| 427 | 427 | ||
| 428 | (defcustom browse-url-mosaic-program "xmosaic" | ||
| 429 | "The name by which to invoke Mosaic (or mMosaic)." | ||
| 430 | :type 'string | ||
| 431 | :version "20.3") | ||
| 432 | |||
| 433 | (make-obsolete-variable 'browse-url-mosaic-program nil "25.1") | ||
| 434 | |||
| 435 | (defcustom browse-url-mosaic-arguments nil | ||
| 436 | "A list of strings to pass to Mosaic as arguments." | ||
| 437 | :type '(repeat (string :tag "Argument"))) | ||
| 438 | |||
| 439 | (make-obsolete-variable 'browse-url-mosaic-arguments nil "25.1") | ||
| 440 | |||
| 441 | (defcustom browse-url-mosaic-pidfile "~/.mosaicpid" | ||
| 442 | "The name of the pidfile created by Mosaic." | ||
| 443 | :type 'string) | ||
| 444 | |||
| 445 | (make-obsolete-variable 'browse-url-mosaic-pidfile nil "25.1") | ||
| 446 | |||
| 447 | (defcustom browse-url-conkeror-program "conkeror" | 428 | (defcustom browse-url-conkeror-program "conkeror" |
| 448 | "The name by which to invoke Conkeror." | 429 | "The name by which to invoke Conkeror." |
| 449 | :type 'string | 430 | :type 'string |
| @@ -498,22 +479,6 @@ Used by the `browse-url-of-file' command." | |||
| 498 | "Hook run after `browse-url-of-file' has asked a browser to load a file." | 479 | "Hook run after `browse-url-of-file' has asked a browser to load a file." |
| 499 | :type 'hook) | 480 | :type 'hook) |
| 500 | 481 | ||
| 501 | (defcustom browse-url-CCI-port 3003 | ||
| 502 | "Port to access XMosaic via CCI. | ||
| 503 | This can be any number between 1024 and 65535 but must correspond to | ||
| 504 | the value set in the browser." | ||
| 505 | :type 'integer) | ||
| 506 | |||
| 507 | (make-obsolete-variable 'browse-url-CCI-port nil "25.1") | ||
| 508 | |||
| 509 | (defcustom browse-url-CCI-host "localhost" | ||
| 510 | "Host to access XMosaic via CCI. | ||
| 511 | This should be the host name of the machine running XMosaic with CCI | ||
| 512 | enabled. The port number should be set in `browse-url-CCI-port'." | ||
| 513 | :type 'string) | ||
| 514 | |||
| 515 | (make-obsolete-variable 'browse-url-CCI-host nil "25.1") | ||
| 516 | |||
| 517 | (defvar browse-url-temp-file-name nil) | 482 | (defvar browse-url-temp-file-name nil) |
| 518 | (make-variable-buffer-local 'browse-url-temp-file-name) | 483 | (make-variable-buffer-local 'browse-url-temp-file-name) |
| 519 | 484 | ||
| @@ -622,7 +587,7 @@ process), or nil (we don't know)." | |||
| 622 | kind))) | 587 | kind))) |
| 623 | 588 | ||
| 624 | (defun browse-url--mailto (url &rest args) | 589 | (defun browse-url--mailto (url &rest args) |
| 625 | "Calls `browse-url-mailto-function' with URL and ARGS." | 590 | "Call `browse-url-mailto-function' with URL and ARGS." |
| 626 | (funcall browse-url-mailto-function url args)) | 591 | (funcall browse-url-mailto-function url args)) |
| 627 | 592 | ||
| 628 | (defun browse-url--browser-kind-mailto (url) | 593 | (defun browse-url--browser-kind-mailto (url) |
| @@ -631,7 +596,7 @@ process), or nil (we don't know)." | |||
| 631 | #'browse-url--browser-kind-mailto) | 596 | #'browse-url--browser-kind-mailto) |
| 632 | 597 | ||
| 633 | (defun browse-url--man (url &rest args) | 598 | (defun browse-url--man (url &rest args) |
| 634 | "Calls `browse-url-man-function' with URL and ARGS." | 599 | "Call `browse-url-man-function' with URL and ARGS." |
| 635 | (funcall browse-url-man-function url args)) | 600 | (funcall browse-url-man-function url args)) |
| 636 | 601 | ||
| 637 | (defun browse-url--browser-kind-man (url) | 602 | (defun browse-url--browser-kind-man (url) |
| @@ -640,7 +605,7 @@ process), or nil (we don't know)." | |||
| 640 | #'browse-url--browser-kind-man) | 605 | #'browse-url--browser-kind-man) |
| 641 | 606 | ||
| 642 | (defun browse-url--browser (url &rest args) | 607 | (defun browse-url--browser (url &rest args) |
| 643 | "Calls `browse-url-browser-function' with URL and ARGS." | 608 | "Call `browse-url-browser-function' with URL and ARGS." |
| 644 | (funcall browse-url-browser-function url args)) | 609 | (funcall browse-url-browser-function url args)) |
| 645 | 610 | ||
| 646 | (defun browse-url--browser-kind-browser (url) | 611 | (defun browse-url--browser-kind-browser (url) |
| @@ -854,8 +819,8 @@ narrowed." | |||
| 854 | (browse-url-of-file file-name)))) | 819 | (browse-url-of-file file-name)))) |
| 855 | 820 | ||
| 856 | (defun browse-url-delete-temp-file (&optional temp-file-name) | 821 | (defun browse-url-delete-temp-file (&optional temp-file-name) |
| 857 | ;; Delete browse-url-temp-file-name from the file system | 822 | "Delete `browse-url-temp-file-name' from the file system. |
| 858 | ;; If optional arg TEMP-FILE-NAME is non-nil, delete it instead | 823 | If optional arg TEMP-FILE-NAME is non-nil, delete it instead." |
| 859 | (let ((file-name (or temp-file-name browse-url-temp-file-name))) | 824 | (let ((file-name (or temp-file-name browse-url-temp-file-name))) |
| 860 | (if (and file-name (file-exists-p file-name)) | 825 | (if (and file-name (file-exists-p file-name)) |
| 861 | (delete-file file-name)))) | 826 | (delete-file file-name)))) |
| @@ -1075,8 +1040,6 @@ instead of `browse-url-new-window-flag'." | |||
| 1075 | ;;; ((executable-find browse-url-galeon-program) 'browse-url-galeon) | 1040 | ;;; ((executable-find browse-url-galeon-program) 'browse-url-galeon) |
| 1076 | ((executable-find browse-url-kde-program) 'browse-url-kde) | 1041 | ((executable-find browse-url-kde-program) 'browse-url-kde) |
| 1077 | ;;; ((executable-find browse-url-netscape-program) 'browse-url-netscape) | 1042 | ;;; ((executable-find browse-url-netscape-program) 'browse-url-netscape) |
| 1078 | ;;; ((executable-find browse-url-mosaic-program) 'browse-url-mosaic) | ||
| 1079 | ;;; ((executable-find browse-url-conkeror-program) 'browse-url-conkeror) | ||
| 1080 | ((executable-find browse-url-chrome-program) 'browse-url-chrome) | 1043 | ((executable-find browse-url-chrome-program) 'browse-url-chrome) |
| 1081 | ((executable-find browse-url-xterm-program) 'browse-url-text-xterm) | 1044 | ((executable-find browse-url-xterm-program) 'browse-url-text-xterm) |
| 1082 | ((locate-library "w3") 'browse-url-w3) | 1045 | ((locate-library "w3") 'browse-url-w3) |
| @@ -1444,93 +1407,6 @@ used instead of `browse-url-new-window-flag'." | |||
| 1444 | 1407 | ||
| 1445 | (function-put 'browse-url-gnome-moz 'browse-url-browser-kind 'external) | 1408 | (function-put 'browse-url-gnome-moz 'browse-url-browser-kind 'external) |
| 1446 | 1409 | ||
| 1447 | ;; --- Mosaic --- | ||
| 1448 | |||
| 1449 | ;;;###autoload | ||
| 1450 | (defun browse-url-mosaic (url &optional new-window) | ||
| 1451 | "Ask the XMosaic WWW browser to load URL. | ||
| 1452 | |||
| 1453 | Default to the URL around or before point. The strings in variable | ||
| 1454 | `browse-url-mosaic-arguments' are also passed to Mosaic and the | ||
| 1455 | program is invoked according to the variable | ||
| 1456 | `browse-url-mosaic-program'. | ||
| 1457 | |||
| 1458 | When called interactively, if variable `browse-url-new-window-flag' is | ||
| 1459 | non-nil, load the document in a new Mosaic window, otherwise use a | ||
| 1460 | random existing one. A non-nil interactive prefix argument reverses | ||
| 1461 | the effect of `browse-url-new-window-flag'. | ||
| 1462 | |||
| 1463 | When called non-interactively, optional second argument NEW-WINDOW is | ||
| 1464 | used instead of `browse-url-new-window-flag'." | ||
| 1465 | (declare (obsolete nil "25.1")) | ||
| 1466 | (interactive (browse-url-interactive-arg "Mosaic URL: ")) | ||
| 1467 | (let ((pidfile (expand-file-name browse-url-mosaic-pidfile)) | ||
| 1468 | pid) | ||
| 1469 | (if (file-readable-p pidfile) | ||
| 1470 | (with-temp-buffer | ||
| 1471 | (insert-file-contents pidfile) | ||
| 1472 | (setq pid (read (current-buffer))))) | ||
| 1473 | (if (and (integerp pid) (zerop (signal-process pid 0))) ; Mosaic running | ||
| 1474 | (progn | ||
| 1475 | (with-temp-buffer | ||
| 1476 | (insert (if (browse-url-maybe-new-window new-window) | ||
| 1477 | "newwin\n" | ||
| 1478 | "goto\n") | ||
| 1479 | url "\n") | ||
| 1480 | (with-file-modes ?\700 | ||
| 1481 | (if (file-exists-p | ||
| 1482 | (setq pidfile (format "/tmp/Mosaic.%d" pid))) | ||
| 1483 | (delete-file pidfile)) | ||
| 1484 | ;; https://debbugs.gnu.org/17428. Use O_EXCL. | ||
| 1485 | (write-region nil nil pidfile nil 'silent nil 'excl))) | ||
| 1486 | ;; Send signal SIGUSR to Mosaic | ||
| 1487 | (message "Signaling Mosaic...") | ||
| 1488 | (signal-process pid 'SIGUSR1) | ||
| 1489 | ;; Or you could try: | ||
| 1490 | ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid)) | ||
| 1491 | (message "Signaling Mosaic...done")) | ||
| 1492 | ;; Mosaic not running - start it | ||
| 1493 | (message "Starting %s..." browse-url-mosaic-program) | ||
| 1494 | (apply 'start-process "xmosaic" nil browse-url-mosaic-program | ||
| 1495 | (append browse-url-mosaic-arguments (list url))) | ||
| 1496 | (message "Starting %s...done" browse-url-mosaic-program)))) | ||
| 1497 | |||
| 1498 | (function-put 'browse-url-mosaic 'browse-url-browser-kind 'external) | ||
| 1499 | |||
| 1500 | ;; --- Mosaic using CCI --- | ||
| 1501 | |||
| 1502 | ;;;###autoload | ||
| 1503 | (defun browse-url-cci (url &optional new-window) | ||
| 1504 | "Ask the XMosaic WWW browser to load URL. | ||
| 1505 | Default to the URL around or before point. | ||
| 1506 | |||
| 1507 | This function only works for XMosaic version 2.5 or later. You must | ||
| 1508 | select `CCI' from XMosaic's File menu, set the CCI Port Address to the | ||
| 1509 | value of variable `browse-url-CCI-port', and enable `Accept requests'. | ||
| 1510 | |||
| 1511 | When called interactively, if variable `browse-url-new-window-flag' is | ||
| 1512 | non-nil, load the document in a new browser window, otherwise use a | ||
| 1513 | random existing one. A non-nil interactive prefix argument reverses | ||
| 1514 | the effect of `browse-url-new-window-flag'. | ||
| 1515 | |||
| 1516 | When called non-interactively, optional second argument NEW-WINDOW is | ||
| 1517 | used instead of `browse-url-new-window-flag'." | ||
| 1518 | (declare (obsolete nil "25.1")) | ||
| 1519 | (interactive (browse-url-interactive-arg "Mosaic URL: ")) | ||
| 1520 | (open-network-stream "browse-url" " *browse-url*" | ||
| 1521 | browse-url-CCI-host browse-url-CCI-port) | ||
| 1522 | ;; Todo: start browser if fails | ||
| 1523 | (process-send-string "browse-url" | ||
| 1524 | (concat "get url (" url ") output " | ||
| 1525 | (if (browse-url-maybe-new-window new-window) | ||
| 1526 | "new" | ||
| 1527 | "current") | ||
| 1528 | "\r\n")) | ||
| 1529 | (process-send-string "browse-url" "disconnect\r\n") | ||
| 1530 | (delete-process "browse-url")) | ||
| 1531 | |||
| 1532 | (function-put 'browse-url-cci 'browse-url-browser-kind 'external) | ||
| 1533 | |||
| 1534 | ;; --- Conkeror --- | 1410 | ;; --- Conkeror --- |
| 1535 | ;;;###autoload | 1411 | ;;;###autoload |
| 1536 | (defun browse-url-conkeror (url &optional new-window) | 1412 | (defun browse-url-conkeror (url &optional new-window) |
diff --git a/lisp/net/eww.el b/lisp/net/eww.el index edb2f729c8b..e7170b3e6d1 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el | |||
| @@ -277,6 +277,24 @@ This list can be customized via `eww-suggest-uris'." | |||
| 277 | (nreverse uris))) | 277 | (nreverse uris))) |
| 278 | 278 | ||
| 279 | ;;;###autoload | 279 | ;;;###autoload |
| 280 | (defun eww-browse () | ||
| 281 | "Function to be run to parse command line URLs. | ||
| 282 | This is meant to be used for MIME handlers or command line use. | ||
| 283 | |||
| 284 | Setting the handler for \"text/x-uri;\" to | ||
| 285 | \"emacs -f eww-browse %u\" will then start up Emacs and call eww | ||
| 286 | to browse the url. | ||
| 287 | |||
| 288 | This can also be used on the command line directly: | ||
| 289 | |||
| 290 | emacs -f eww-browse https://gnu.org | ||
| 291 | |||
| 292 | will start Emacs and browse the GNU web site." | ||
| 293 | (interactive) | ||
| 294 | (eww (pop command-line-args-left))) | ||
| 295 | |||
| 296 | |||
| 297 | ;;;###autoload | ||
| 280 | (defun eww (url &optional arg buffer) | 298 | (defun eww (url &optional arg buffer) |
| 281 | "Fetch URL and render the page. | 299 | "Fetch URL and render the page. |
| 282 | If the input doesn't look like an URL or a domain name, the | 300 | If the input doesn't look like an URL or a domain name, the |
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 7e5af6910bb..88f5c2928e3 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el | |||
| @@ -96,8 +96,10 @@ It is used for TCP/IP devices." | |||
| 96 | (tramp--with-startup | 96 | (tramp--with-startup |
| 97 | (add-to-list 'tramp-methods | 97 | (add-to-list 'tramp-methods |
| 98 | `(,tramp-adb-method | 98 | `(,tramp-adb-method |
| 99 | (tramp-tmpdir "/data/local/tmp") | 99 | (tramp-login-program ,tramp-adb-program) |
| 100 | (tramp-default-port 5555))) | 100 | (tramp-login-args (("shell"))) |
| 101 | (tramp-tmpdir "/data/local/tmp") | ||
| 102 | (tramp-default-port 5555))) | ||
| 101 | 103 | ||
| 102 | (add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil "")) | 104 | (add-to-list 'tramp-default-host-alist `(,tramp-adb-method nil "")) |
| 103 | 105 | ||
| @@ -885,158 +887,163 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored." | |||
| 885 | ;; The complete STDERR buffer is available only when the process has | 887 | ;; The complete STDERR buffer is available only when the process has |
| 886 | ;; terminated. | 888 | ;; terminated. |
| 887 | (defun tramp-adb-handle-make-process (&rest args) | 889 | (defun tramp-adb-handle-make-process (&rest args) |
| 888 | "Like `make-process' for Tramp files." | 890 | "Like `make-process' for Tramp files. |
| 889 | (when args | 891 | If connection property \"direct-async-process\" is non-nil, an |
| 890 | (with-parsed-tramp-file-name (expand-file-name default-directory) nil | 892 | alternative implementation will be used." |
| 891 | (let ((name (plist-get args :name)) | 893 | (if (tramp-get-connection-property |
| 892 | (buffer (plist-get args :buffer)) | 894 | (tramp-dissect-file-name default-directory) "direct-async-process" nil) |
| 893 | (command (plist-get args :command)) | 895 | (apply #'tramp-handle-make-process args) |
| 894 | (coding (plist-get args :coding)) | 896 | (when args |
| 895 | (noquery (plist-get args :noquery)) | 897 | (with-parsed-tramp-file-name (expand-file-name default-directory) nil |
| 896 | (connection-type (plist-get args :connection-type)) | 898 | (let ((name (plist-get args :name)) |
| 897 | (filter (plist-get args :filter)) | 899 | (buffer (plist-get args :buffer)) |
| 898 | (sentinel (plist-get args :sentinel)) | 900 | (command (plist-get args :command)) |
| 899 | (stderr (plist-get args :stderr))) | 901 | (coding (plist-get args :coding)) |
| 900 | (unless (stringp name) | 902 | (noquery (plist-get args :noquery)) |
| 901 | (signal 'wrong-type-argument (list #'stringp name))) | 903 | (connection-type (plist-get args :connection-type)) |
| 902 | (unless (or (null buffer) (bufferp buffer) (stringp buffer)) | 904 | (filter (plist-get args :filter)) |
| 903 | (signal 'wrong-type-argument (list #'stringp buffer))) | 905 | (sentinel (plist-get args :sentinel)) |
| 904 | (unless (consp command) | 906 | (stderr (plist-get args :stderr))) |
| 905 | (signal 'wrong-type-argument (list #'consp command))) | 907 | (unless (stringp name) |
| 906 | (unless (or (null coding) | 908 | (signal 'wrong-type-argument (list #'stringp name))) |
| 907 | (and (symbolp coding) (memq coding coding-system-list)) | 909 | (unless (or (null buffer) (bufferp buffer) (stringp buffer)) |
| 908 | (and (consp coding) | 910 | (signal 'wrong-type-argument (list #'stringp buffer))) |
| 909 | (memq (car coding) coding-system-list) | 911 | (unless (consp command) |
| 910 | (memq (cdr coding) coding-system-list))) | 912 | (signal 'wrong-type-argument (list #'consp command))) |
| 911 | (signal 'wrong-type-argument (list #'symbolp coding))) | 913 | (unless (or (null coding) |
| 912 | (unless (or (null connection-type) (memq connection-type '(pipe pty))) | 914 | (and (symbolp coding) (memq coding coding-system-list)) |
| 913 | (signal 'wrong-type-argument (list #'symbolp connection-type))) | 915 | (and (consp coding) |
| 914 | (unless (or (null filter) (functionp filter)) | 916 | (memq (car coding) coding-system-list) |
| 915 | (signal 'wrong-type-argument (list #'functionp filter))) | 917 | (memq (cdr coding) coding-system-list))) |
| 916 | (unless (or (null sentinel) (functionp sentinel)) | 918 | (signal 'wrong-type-argument (list #'symbolp coding))) |
| 917 | (signal 'wrong-type-argument (list #'functionp sentinel))) | 919 | (unless (or (null connection-type) (memq connection-type '(pipe pty))) |
| 918 | (unless (or (null stderr) (bufferp stderr) (stringp stderr)) | 920 | (signal 'wrong-type-argument (list #'symbolp connection-type))) |
| 919 | (signal 'wrong-type-argument (list #'stringp stderr))) | 921 | (unless (or (null filter) (functionp filter)) |
| 920 | (when (and (stringp stderr) (tramp-tramp-file-p stderr) | 922 | (signal 'wrong-type-argument (list #'functionp filter))) |
| 921 | (not (tramp-equal-remote default-directory stderr))) | 923 | (unless (or (null sentinel) (functionp sentinel)) |
| 922 | (signal 'file-error (list "Wrong stderr" stderr))) | 924 | (signal 'wrong-type-argument (list #'functionp sentinel))) |
| 923 | 925 | (unless (or (null stderr) (bufferp stderr) (stringp stderr)) | |
| 924 | (let* ((buffer | 926 | (signal 'wrong-type-argument (list #'stringp stderr))) |
| 925 | (if buffer | 927 | (when (and (stringp stderr) (tramp-tramp-file-p stderr) |
| 926 | (get-buffer-create buffer) | 928 | (not (tramp-equal-remote default-directory stderr))) |
| 927 | ;; BUFFER can be nil. We use a temporary buffer. | 929 | (signal 'file-error (list "Wrong stderr" stderr))) |
| 928 | (generate-new-buffer tramp-temp-buffer-name))) | 930 | |
| 929 | ;; STDERR can also be a file name. | 931 | (let* ((buffer |
| 930 | (tmpstderr | 932 | (if buffer |
| 931 | (and stderr | 933 | (get-buffer-create buffer) |
| 932 | (if (and (stringp stderr) (tramp-tramp-file-p stderr)) | 934 | ;; BUFFER can be nil. We use a temporary buffer. |
| 933 | (tramp-unquote-file-local-name stderr) | 935 | (generate-new-buffer tramp-temp-buffer-name))) |
| 934 | (tramp-make-tramp-temp-file v)))) | 936 | ;; STDERR can also be a file name. |
| 935 | (remote-tmpstderr | 937 | (tmpstderr |
| 936 | (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) | 938 | (and stderr |
| 937 | (program (car command)) | 939 | (if (and (stringp stderr) (tramp-tramp-file-p stderr)) |
| 938 | (args (cdr command)) | 940 | (tramp-unquote-file-local-name stderr) |
| 939 | (command | 941 | (tramp-make-tramp-temp-file v)))) |
| 940 | (format "cd %s && exec %s %s" | 942 | (remote-tmpstderr |
| 941 | (tramp-shell-quote-argument localname) | 943 | (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) |
| 942 | (if tmpstderr (format "2>'%s'" tmpstderr) "") | 944 | (program (car command)) |
| 943 | (mapconcat #'tramp-shell-quote-argument | 945 | (args (cdr command)) |
| 944 | (cons program args) " "))) | 946 | (command |
| 945 | (tramp-process-connection-type | 947 | (format "cd %s && exec %s %s" |
| 946 | (or (null program) tramp-process-connection-type)) | 948 | (tramp-shell-quote-argument localname) |
| 947 | (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) | 949 | (if tmpstderr (format "2>'%s'" tmpstderr) "") |
| 948 | (name1 name) | 950 | (mapconcat #'tramp-shell-quote-argument |
| 949 | (i 0)) | 951 | (cons program args) " "))) |
| 950 | 952 | (tramp-process-connection-type | |
| 951 | (while (get-process name1) | 953 | (or (null program) tramp-process-connection-type)) |
| 952 | ;; NAME must be unique as process name. | 954 | (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) |
| 953 | (setq i (1+ i) | 955 | (name1 name) |
| 954 | name1 (format "%s<%d>" name i))) | 956 | (i 0)) |
| 955 | (setq name name1) | 957 | |
| 956 | ;; Set the new process properties. | 958 | (while (get-process name1) |
| 957 | (tramp-set-connection-property v "process-name" name) | 959 | ;; NAME must be unique as process name. |
| 958 | (tramp-set-connection-property v "process-buffer" buffer) | 960 | (setq i (1+ i) |
| 959 | 961 | name1 (format "%s<%d>" name i))) | |
| 960 | (with-current-buffer (tramp-get-connection-buffer v) | 962 | (setq name name1) |
| 961 | (unwind-protect | 963 | ;; Set the new process properties. |
| 962 | ;; We catch this event. Otherwise, `make-process' | 964 | (tramp-set-connection-property v "process-name" name) |
| 963 | ;; could be called on the local host. | 965 | (tramp-set-connection-property v "process-buffer" buffer) |
| 964 | (save-excursion | 966 | |
| 965 | (save-restriction | 967 | (with-current-buffer (tramp-get-connection-buffer v) |
| 966 | ;; Activate narrowing in order to save BUFFER | 968 | (unwind-protect |
| 967 | ;; contents. Clear also the modification time; | 969 | ;; We catch this event. Otherwise, `make-process' |
| 968 | ;; otherwise we might be interrupted by | 970 | ;; could be called on the local host. |
| 969 | ;; `verify-visited-file-modtime'. | 971 | (save-excursion |
| 970 | (let ((buffer-undo-list t) | 972 | (save-restriction |
| 971 | (inhibit-read-only t)) | 973 | ;; Activate narrowing in order to save BUFFER |
| 972 | (clear-visited-file-modtime) | 974 | ;; contents. Clear also the modification time; |
| 973 | (narrow-to-region (point-max) (point-max)) | 975 | ;; otherwise we might be interrupted by |
| 974 | ;; We call `tramp-adb-maybe-open-connection', in | 976 | ;; `verify-visited-file-modtime'. |
| 975 | ;; order to cleanup the prompt afterwards. | 977 | (let ((buffer-undo-list t) |
| 976 | (tramp-adb-maybe-open-connection v) | 978 | (inhibit-read-only t)) |
| 977 | (delete-region (point-min) (point-max)) | 979 | (clear-visited-file-modtime) |
| 978 | ;; Send the command. | 980 | (narrow-to-region (point-max) (point-max)) |
| 979 | (let* ((p (tramp-get-connection-process v))) | 981 | ;; We call `tramp-adb-maybe-open-connection', |
| 980 | (tramp-adb-send-command v command nil t) ; nooutput | 982 | ;; in order to cleanup the prompt afterwards. |
| 981 | ;; Set sentinel and filter. | 983 | (tramp-adb-maybe-open-connection v) |
| 982 | (when sentinel | 984 | (delete-region (point-min) (point-max)) |
| 983 | (set-process-sentinel p sentinel)) | 985 | ;; Send the command. |
| 984 | (when filter | 986 | (let* ((p (tramp-get-connection-process v))) |
| 985 | (set-process-filter p filter)) | 987 | (tramp-adb-send-command v command nil t) ; nooutput |
| 986 | ;; Set query flag and process marker for this | 988 | ;; Set sentinel and filter. |
| 987 | ;; process. We ignore errors, because the | 989 | (when sentinel |
| 988 | ;; process could have finished already. | 990 | (set-process-sentinel p sentinel)) |
| 989 | (ignore-errors | 991 | (when filter |
| 990 | (set-process-query-on-exit-flag p (null noquery)) | 992 | (set-process-filter p filter)) |
| 991 | (set-marker (process-mark p) (point))) | 993 | ;; Set query flag and process marker for |
| 992 | ;; We must flush them here already; otherwise | 994 | ;; this process. We ignore errors, because |
| 993 | ;; `rename-file', `delete-file' or | 995 | ;; the process could have finished already. |
| 994 | ;; `insert-file-contents' will fail. | 996 | (ignore-errors |
| 995 | (tramp-flush-connection-property v "process-name") | 997 | (set-process-query-on-exit-flag p (null noquery)) |
| 996 | (tramp-flush-connection-property v "process-buffer") | 998 | (set-marker (process-mark p) (point))) |
| 997 | ;; Copy tmpstderr file. | 999 | ;; We must flush them here already; |
| 998 | (when (and (stringp stderr) | 1000 | ;; otherwise `rename-file', `delete-file' or |
| 999 | (not (tramp-tramp-file-p stderr))) | 1001 | ;; `insert-file-contents' will fail. |
| 1000 | (add-function | 1002 | (tramp-flush-connection-property v "process-name") |
| 1001 | :after (process-sentinel p) | 1003 | (tramp-flush-connection-property v "process-buffer") |
| 1002 | (lambda (_proc _msg) | 1004 | ;; Copy tmpstderr file. |
| 1003 | (rename-file remote-tmpstderr stderr)))) | 1005 | (when (and (stringp stderr) |
| 1004 | ;; Read initial output. Remove the first line, | 1006 | (not (tramp-tramp-file-p stderr))) |
| 1005 | ;; which is the command echo. | 1007 | (add-function |
| 1006 | (while | 1008 | :after (process-sentinel p) |
| 1007 | (progn | 1009 | (lambda (_proc _msg) |
| 1008 | (goto-char (point-min)) | 1010 | (rename-file remote-tmpstderr stderr)))) |
| 1009 | (not (re-search-forward "[\n]" nil t))) | 1011 | ;; Read initial output. Remove the first |
| 1010 | (tramp-accept-process-output p 0)) | 1012 | ;; line, which is the command echo. |
| 1011 | (delete-region (point-min) (point)) | 1013 | (while |
| 1012 | ;; Provide error buffer. This shows only | 1014 | (progn |
| 1013 | ;; initial error messages; messages arriving | 1015 | (goto-char (point-min)) |
| 1014 | ;; later on will be inserted when the process | 1016 | (not (re-search-forward "[\n]" nil t))) |
| 1015 | ;; is deleted. The temporary file will exist | 1017 | (tramp-accept-process-output p 0)) |
| 1016 | ;; until the process is deleted. | 1018 | (delete-region (point-min) (point)) |
| 1017 | (when (bufferp stderr) | 1019 | ;; Provide error buffer. This shows only |
| 1018 | (with-current-buffer stderr | 1020 | ;; initial error messages; messages arriving |
| 1019 | (insert-file-contents-literally | 1021 | ;; later on will be inserted when the |
| 1020 | remote-tmpstderr 'visit)) | 1022 | ;; process is deleted. The temporary file |
| 1021 | ;; Delete tmpstderr file. | 1023 | ;; will exist until the process is deleted. |
| 1022 | (add-function | 1024 | (when (bufferp stderr) |
| 1023 | :after (process-sentinel p) | 1025 | (with-current-buffer stderr |
| 1024 | (lambda (_proc _msg) | 1026 | (insert-file-contents-literally |
| 1025 | (with-current-buffer stderr | 1027 | remote-tmpstderr 'visit)) |
| 1026 | (insert-file-contents-literally | 1028 | ;; Delete tmpstderr file. |
| 1027 | remote-tmpstderr 'visit nil nil 'replace)) | 1029 | (add-function |
| 1028 | (delete-file remote-tmpstderr)))) | 1030 | :after (process-sentinel p) |
| 1029 | ;; Return process. | 1031 | (lambda (_proc _msg) |
| 1030 | p)))) | 1032 | (with-current-buffer stderr |
| 1031 | 1033 | (insert-file-contents-literally | |
| 1032 | ;; Save exit. | 1034 | remote-tmpstderr 'visit nil nil 'replace)) |
| 1033 | (if (string-match-p tramp-temp-buffer-name (buffer-name)) | 1035 | (delete-file remote-tmpstderr)))) |
| 1034 | (ignore-errors | 1036 | ;; Return process. |
| 1035 | (set-process-buffer (tramp-get-connection-process v) nil) | 1037 | p)))) |
| 1036 | (kill-buffer (current-buffer))) | 1038 | |
| 1037 | (set-buffer-modified-p bmp)) | 1039 | ;; Save exit. |
| 1038 | (tramp-flush-connection-property v "process-name") | 1040 | (if (string-match-p tramp-temp-buffer-name (buffer-name)) |
| 1039 | (tramp-flush-connection-property v "process-buffer")))))))) | 1041 | (ignore-errors |
| 1042 | (set-process-buffer (tramp-get-connection-process v) nil) | ||
| 1043 | (kill-buffer (current-buffer))) | ||
| 1044 | (set-buffer-modified-p bmp)) | ||
| 1045 | (tramp-flush-connection-property v "process-name") | ||
| 1046 | (tramp-flush-connection-property v "process-buffer"))))))))) | ||
| 1040 | 1047 | ||
| 1041 | (defun tramp-adb-handle-exec-path () | 1048 | (defun tramp-adb-handle-exec-path () |
| 1042 | "Like `exec-path' for Tramp files." | 1049 | "Like `exec-path' for Tramp files." |
| @@ -1253,6 +1260,14 @@ connection if a previous connection has died for some reason." | |||
| 1253 | (tramp-adb-send-command | 1260 | (tramp-adb-send-command |
| 1254 | vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt)) | 1261 | vec (format "PS1=\"///\"\"%s\"\"#$\"" prompt)) |
| 1255 | 1262 | ||
| 1263 | ;; Disable line editing. | ||
| 1264 | (tramp-adb-send-command | ||
| 1265 | vec "set +o vi +o vi-esccomplete +o vi-tabcomplete +o emacs") | ||
| 1266 | |||
| 1267 | ;; Dump option settings in the traces. | ||
| 1268 | (when (>= tramp-verbose 9) | ||
| 1269 | (tramp-adb-send-command vec "set -o")) | ||
| 1270 | |||
| 1256 | ;; Check whether the properties have been changed. If | 1271 | ;; Check whether the properties have been changed. If |
| 1257 | ;; yes, this is a strong indication that we must expire all | 1272 | ;; yes, this is a strong indication that we must expire all |
| 1258 | ;; connection properties. We start again. | 1273 | ;; connection properties. We start again. |
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index f9f0cbcc023..3e2eb023a33 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el | |||
| @@ -2787,228 +2787,233 @@ the result will be a local, non-Tramp, file name." | |||
| 2787 | ;; terminated. | 2787 | ;; terminated. |
| 2788 | (defun tramp-sh-handle-make-process (&rest args) | 2788 | (defun tramp-sh-handle-make-process (&rest args) |
| 2789 | "Like `make-process' for Tramp files. | 2789 | "Like `make-process' for Tramp files. |
| 2790 | STDERR can also be a file name." | 2790 | STDERR can also be a file name. If connection property |
| 2791 | (when args | 2791 | \"direct-async-process\" is non-nil, an alternative |
| 2792 | (with-parsed-tramp-file-name (expand-file-name default-directory) nil | 2792 | implementation will be used." |
| 2793 | (let ((name (plist-get args :name)) | 2793 | (if (tramp-get-connection-property |
| 2794 | (buffer (plist-get args :buffer)) | 2794 | (tramp-dissect-file-name default-directory) "direct-async-process" nil) |
| 2795 | (command (plist-get args :command)) | 2795 | (apply #'tramp-handle-make-process args) |
| 2796 | (coding (plist-get args :coding)) | 2796 | (when args |
| 2797 | (noquery (plist-get args :noquery)) | 2797 | (with-parsed-tramp-file-name (expand-file-name default-directory) nil |
| 2798 | (connection-type (plist-get args :connection-type)) | 2798 | (let ((name (plist-get args :name)) |
| 2799 | (filter (plist-get args :filter)) | 2799 | (buffer (plist-get args :buffer)) |
| 2800 | (sentinel (plist-get args :sentinel)) | 2800 | (command (plist-get args :command)) |
| 2801 | (stderr (plist-get args :stderr))) | 2801 | (coding (plist-get args :coding)) |
| 2802 | (unless (stringp name) | 2802 | (noquery (plist-get args :noquery)) |
| 2803 | (signal 'wrong-type-argument (list #'stringp name))) | 2803 | (connection-type (plist-get args :connection-type)) |
| 2804 | (unless (or (null buffer) (bufferp buffer) (stringp buffer)) | 2804 | (filter (plist-get args :filter)) |
| 2805 | (signal 'wrong-type-argument (list #'stringp buffer))) | 2805 | (sentinel (plist-get args :sentinel)) |
| 2806 | (unless (consp command) | 2806 | (stderr (plist-get args :stderr))) |
| 2807 | (signal 'wrong-type-argument (list #'consp command))) | 2807 | (unless (stringp name) |
| 2808 | (unless (or (null coding) | 2808 | (signal 'wrong-type-argument (list #'stringp name))) |
| 2809 | (and (symbolp coding) (memq coding coding-system-list)) | 2809 | (unless (or (null buffer) (bufferp buffer) (stringp buffer)) |
| 2810 | (and (consp coding) | 2810 | (signal 'wrong-type-argument (list #'stringp buffer))) |
| 2811 | (memq (car coding) coding-system-list) | 2811 | (unless (consp command) |
| 2812 | (memq (cdr coding) coding-system-list))) | 2812 | (signal 'wrong-type-argument (list #'consp command))) |
| 2813 | (signal 'wrong-type-argument (list #'symbolp coding))) | 2813 | (unless (or (null coding) |
| 2814 | (unless (or (null connection-type) (memq connection-type '(pipe pty))) | 2814 | (and (symbolp coding) (memq coding coding-system-list)) |
| 2815 | (signal 'wrong-type-argument (list #'symbolp connection-type))) | 2815 | (and (consp coding) |
| 2816 | (unless (or (null filter) (functionp filter)) | 2816 | (memq (car coding) coding-system-list) |
| 2817 | (signal 'wrong-type-argument (list #'functionp filter))) | 2817 | (memq (cdr coding) coding-system-list))) |
| 2818 | (unless (or (null sentinel) (functionp sentinel)) | 2818 | (signal 'wrong-type-argument (list #'symbolp coding))) |
| 2819 | (signal 'wrong-type-argument (list #'functionp sentinel))) | 2819 | (unless (or (null connection-type) (memq connection-type '(pipe pty))) |
| 2820 | (unless (or (null stderr) (bufferp stderr) (stringp stderr)) | 2820 | (signal 'wrong-type-argument (list #'symbolp connection-type))) |
| 2821 | (signal 'wrong-type-argument (list #'stringp stderr))) | 2821 | (unless (or (null filter) (functionp filter)) |
| 2822 | (when (and (stringp stderr) (tramp-tramp-file-p stderr) | 2822 | (signal 'wrong-type-argument (list #'functionp filter))) |
| 2823 | (not (tramp-equal-remote default-directory stderr))) | 2823 | (unless (or (null sentinel) (functionp sentinel)) |
| 2824 | (signal 'file-error (list "Wrong stderr" stderr))) | 2824 | (signal 'wrong-type-argument (list #'functionp sentinel))) |
| 2825 | 2825 | (unless (or (null stderr) (bufferp stderr) (stringp stderr)) | |
| 2826 | (let* ((buffer | 2826 | (signal 'wrong-type-argument (list #'stringp stderr))) |
| 2827 | (if buffer | 2827 | (when (and (stringp stderr) (tramp-tramp-file-p stderr) |
| 2828 | (get-buffer-create buffer) | 2828 | (not (tramp-equal-remote default-directory stderr))) |
| 2829 | ;; BUFFER can be nil. We use a temporary buffer. | 2829 | (signal 'file-error (list "Wrong stderr" stderr))) |
| 2830 | (generate-new-buffer tramp-temp-buffer-name))) | 2830 | |
| 2831 | ;; STDERR can also be a file name. | 2831 | (let* ((buffer |
| 2832 | (tmpstderr | 2832 | (if buffer |
| 2833 | (and stderr | 2833 | (get-buffer-create buffer) |
| 2834 | (if (and (stringp stderr) (tramp-tramp-file-p stderr)) | 2834 | ;; BUFFER can be nil. We use a temporary buffer. |
| 2835 | (tramp-unquote-file-local-name stderr) | 2835 | (generate-new-buffer tramp-temp-buffer-name))) |
| 2836 | (tramp-make-tramp-temp-file v)))) | 2836 | ;; STDERR can also be a file name. |
| 2837 | (remote-tmpstderr | 2837 | (tmpstderr |
| 2838 | (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) | 2838 | (and stderr |
| 2839 | (program (car command)) | 2839 | (if (and (stringp stderr) (tramp-tramp-file-p stderr)) |
| 2840 | (args (cdr command)) | 2840 | (tramp-unquote-file-local-name stderr) |
| 2841 | ;; When PROGRAM matches "*sh", and the first arg is | 2841 | (tramp-make-tramp-temp-file v)))) |
| 2842 | ;; "-c", it might be that the arguments exceed the | 2842 | (remote-tmpstderr |
| 2843 | ;; command line length. Therefore, we modify the | 2843 | (and tmpstderr (tramp-make-tramp-file-name v tmpstderr))) |
| 2844 | ;; command. | 2844 | (program (car command)) |
| 2845 | (heredoc (and (stringp program) | 2845 | (args (cdr command)) |
| 2846 | (string-match-p "sh$" program) | 2846 | ;; When PROGRAM matches "*sh", and the first arg is |
| 2847 | (string-equal "-c" (car args)) | 2847 | ;; "-c", it might be that the arguments exceed the |
| 2848 | (= (length args) 2))) | 2848 | ;; command line length. Therefore, we modify the |
| 2849 | ;; When PROGRAM is nil, we just provide a tty. | 2849 | ;; command. |
| 2850 | (args (if (not heredoc) args | 2850 | (heredoc (and (stringp program) |
| 2851 | (let ((i 250)) | 2851 | (string-match-p "sh$" program) |
| 2852 | (while (and (< i (length (cadr args))) | 2852 | (string-equal "-c" (car args)) |
| 2853 | (string-match " " (cadr args) i)) | 2853 | (= (length args) 2))) |
| 2854 | (setcdr | 2854 | ;; When PROGRAM is nil, we just provide a tty. |
| 2855 | args | 2855 | (args (if (not heredoc) args |
| 2856 | (list | 2856 | (let ((i 250)) |
| 2857 | (replace-match " \\\\\n" nil nil (cadr args)))) | 2857 | (while (and (< i (length (cadr args))) |
| 2858 | (setq i (+ i 250)))) | 2858 | (string-match " " (cadr args) i)) |
| 2859 | (cdr args))) | 2859 | (setcdr |
| 2860 | ;; Use a human-friendly prompt, for example for | 2860 | args |
| 2861 | ;; `shell'. We discard hops, if existing, that's why | 2861 | (list |
| 2862 | ;; we cannot use `file-remote-p'. | 2862 | (replace-match " \\\\\n" nil nil (cadr args)))) |
| 2863 | (prompt (format "PS1=%s %s" | 2863 | (setq i (+ i 250)))) |
| 2864 | (tramp-make-tramp-file-name v nil 'nohop) | 2864 | (cdr args))) |
| 2865 | tramp-initial-end-of-output)) | 2865 | ;; Use a human-friendly prompt, for example for |
| 2866 | ;; We use as environment the difference to toplevel | 2866 | ;; `shell'. We discard hops, if existing, that's why |
| 2867 | ;; `process-environment'. | 2867 | ;; we cannot use `file-remote-p'. |
| 2868 | env uenv | 2868 | (prompt (format "PS1=%s %s" |
| 2869 | (env (dolist (elt (cons prompt process-environment) env) | 2869 | (tramp-make-tramp-file-name v nil 'nohop) |
| 2870 | (or (member | 2870 | tramp-initial-end-of-output)) |
| 2871 | elt (default-toplevel-value 'process-environment)) | 2871 | ;; We use as environment the difference to toplevel |
| 2872 | (if (string-match-p "=" elt) | 2872 | ;; `process-environment'. |
| 2873 | (setq env (append env `(,elt))) | 2873 | env uenv |
| 2874 | (if (tramp-get-env-with-u-option v) | 2874 | (env (dolist (elt (cons prompt process-environment) env) |
| 2875 | (setq env (append `("-u" ,elt) env)) | 2875 | (or (member |
| 2876 | (setq uenv (cons elt uenv))))))) | 2876 | elt (default-toplevel-value 'process-environment)) |
| 2877 | (command | 2877 | (if (string-match-p "=" elt) |
| 2878 | (when (stringp program) | 2878 | (setq env (append env `(,elt))) |
| 2879 | (setenv-internal | 2879 | (if (tramp-get-env-with-u-option v) |
| 2880 | env "INSIDE_EMACS" | 2880 | (setq env (append `("-u" ,elt) env)) |
| 2881 | (concat (or (getenv "INSIDE_EMACS") emacs-version) | 2881 | (setq uenv (cons elt uenv))))))) |
| 2882 | ",tramp:" tramp-version) | 2882 | (command |
| 2883 | 'keep) | 2883 | (when (stringp program) |
| 2884 | (format "cd %s && %s exec %s %s env %s %s" | 2884 | (setenv-internal |
| 2885 | (tramp-shell-quote-argument localname) | 2885 | env "INSIDE_EMACS" |
| 2886 | (if uenv | 2886 | (concat (or (getenv "INSIDE_EMACS") emacs-version) |
| 2887 | (format | 2887 | ",tramp:" tramp-version) |
| 2888 | "unset %s &&" | 2888 | 'keep) |
| 2889 | (mapconcat | 2889 | (format "cd %s && %s exec %s %s env %s %s" |
| 2890 | #'tramp-shell-quote-argument uenv " ")) | 2890 | (tramp-shell-quote-argument localname) |
| 2891 | "") | 2891 | (if uenv |
| 2892 | (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "") | 2892 | (format |
| 2893 | (if tmpstderr (format "2>'%s'" tmpstderr) "") | 2893 | "unset %s &&" |
| 2894 | (mapconcat #'tramp-shell-quote-argument env " ") | 2894 | (mapconcat |
| 2895 | (if heredoc | 2895 | #'tramp-shell-quote-argument uenv " ")) |
| 2896 | (format "%s\n(\n%s\n) </dev/tty\n%s" | 2896 | "") |
| 2897 | program (car args) tramp-end-of-heredoc) | 2897 | (if heredoc (format "<<'%s'" tramp-end-of-heredoc) "") |
| 2898 | (mapconcat #'tramp-shell-quote-argument | 2898 | (if tmpstderr (format "2>'%s'" tmpstderr) "") |
| 2899 | (cons program args) " "))))) | 2899 | (mapconcat #'tramp-shell-quote-argument env " ") |
| 2900 | (tramp-process-connection-type | 2900 | (if heredoc |
| 2901 | (or (null program) tramp-process-connection-type)) | 2901 | (format "%s\n(\n%s\n) </dev/tty\n%s" |
| 2902 | (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) | 2902 | program (car args) tramp-end-of-heredoc) |
| 2903 | (name1 name) | 2903 | (mapconcat #'tramp-shell-quote-argument |
| 2904 | (i 0) | 2904 | (cons program args) " "))))) |
| 2905 | ;; We do not want to raise an error when `make-process' | 2905 | (tramp-process-connection-type |
| 2906 | ;; has been started several times in `eshell' and | 2906 | (or (null program) tramp-process-connection-type)) |
| 2907 | ;; friends. | 2907 | (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) |
| 2908 | tramp-current-connection | 2908 | (name1 name) |
| 2909 | p) | 2909 | (i 0) |
| 2910 | 2910 | ;; We do not want to raise an error when | |
| 2911 | (while (get-process name1) | 2911 | ;; `make-process' has been started several times in |
| 2912 | ;; NAME must be unique as process name. | 2912 | ;; `eshell' and friends. |
| 2913 | (setq i (1+ i) | 2913 | tramp-current-connection |
| 2914 | name1 (format "%s<%d>" name i))) | 2914 | p) |
| 2915 | (setq name name1) | 2915 | |
| 2916 | ;; Set the new process properties. | 2916 | (while (get-process name1) |
| 2917 | (tramp-set-connection-property v "process-name" name) | 2917 | ;; NAME must be unique as process name. |
| 2918 | (tramp-set-connection-property v "process-buffer" buffer) | 2918 | (setq i (1+ i) |
| 2919 | 2919 | name1 (format "%s<%d>" name i))) | |
| 2920 | (with-current-buffer (tramp-get-connection-buffer v) | 2920 | (setq name name1) |
| 2921 | (unwind-protect | 2921 | ;; Set the new process properties. |
| 2922 | ;; We catch this event. Otherwise, `make-process' could | 2922 | (tramp-set-connection-property v "process-name" name) |
| 2923 | ;; be called on the local host. | 2923 | (tramp-set-connection-property v "process-buffer" buffer) |
| 2924 | (save-excursion | 2924 | |
| 2925 | (save-restriction | 2925 | (with-current-buffer (tramp-get-connection-buffer v) |
| 2926 | ;; Activate narrowing in order to save BUFFER | 2926 | (unwind-protect |
| 2927 | ;; contents. Clear also the modification time; | 2927 | ;; We catch this event. Otherwise, `make-process' |
| 2928 | ;; otherwise we might be interrupted by | 2928 | ;; could be called on the local host. |
| 2929 | ;; `verify-visited-file-modtime'. | 2929 | (save-excursion |
| 2930 | (let ((buffer-undo-list t) | 2930 | (save-restriction |
| 2931 | (inhibit-read-only t) | 2931 | ;; Activate narrowing in order to save BUFFER |
| 2932 | (mark (point-max))) | 2932 | ;; contents. Clear also the modification time; |
| 2933 | (clear-visited-file-modtime) | 2933 | ;; otherwise we might be interrupted by |
| 2934 | (narrow-to-region (point-max) (point-max)) | 2934 | ;; `verify-visited-file-modtime'. |
| 2935 | ;; We call `tramp-maybe-open-connection', in | 2935 | (let ((buffer-undo-list t) |
| 2936 | ;; order to cleanup the prompt afterwards. | 2936 | (inhibit-read-only t) |
| 2937 | (catch 'suppress | 2937 | (mark (point-max))) |
| 2938 | (tramp-maybe-open-connection v) | 2938 | (clear-visited-file-modtime) |
| 2939 | (setq p (tramp-get-connection-process v)) | ||
| 2940 | ;; Set the pid of the remote shell. This is | ||
| 2941 | ;; needed when sending signals remotely. | ||
| 2942 | (let ((pid (tramp-send-command-and-read v "echo $$"))) | ||
| 2943 | (process-put p 'remote-pid pid) | ||
| 2944 | (tramp-set-connection-property p "remote-pid" pid)) | ||
| 2945 | ;; `tramp-maybe-open-connection' and | ||
| 2946 | ;; `tramp-send-command-and-read' could have | ||
| 2947 | ;; trashed the connection buffer. Remove this. | ||
| 2948 | (widen) | ||
| 2949 | (delete-region mark (point-max)) | ||
| 2950 | (narrow-to-region (point-max) (point-max)) | 2939 | (narrow-to-region (point-max) (point-max)) |
| 2951 | ;; Now do it. | 2940 | ;; We call `tramp-maybe-open-connection', in |
| 2952 | (if command | 2941 | ;; order to cleanup the prompt afterwards. |
| 2953 | ;; Send the command. | 2942 | (catch 'suppress |
| 2954 | (tramp-send-command v command nil t) ; nooutput | 2943 | (tramp-maybe-open-connection v) |
| 2955 | ;; Check, whether a pty is associated. | 2944 | (setq p (tramp-get-connection-process v)) |
| 2956 | (unless (process-get p 'remote-tty) | 2945 | ;; Set the pid of the remote shell. This is |
| 2957 | (tramp-error | 2946 | ;; needed when sending signals remotely. |
| 2958 | v 'file-error | 2947 | (let ((pid (tramp-send-command-and-read v "echo $$"))) |
| 2959 | "pty association is not supported for `%s'" | 2948 | (process-put p 'remote-pid pid) |
| 2960 | name)))) | 2949 | (tramp-set-connection-property p "remote-pid" pid)) |
| 2961 | ;; Set sentinel and filter. | 2950 | ;; `tramp-maybe-open-connection' and |
| 2962 | (when sentinel | 2951 | ;; `tramp-send-command-and-read' could have |
| 2963 | (set-process-sentinel p sentinel)) | 2952 | ;; trashed the connection buffer. Remove this. |
| 2964 | (when filter | 2953 | (widen) |
| 2965 | (set-process-filter p filter)) | 2954 | (delete-region mark (point-max)) |
| 2966 | ;; Set query flag and process marker for this | 2955 | (narrow-to-region (point-max) (point-max)) |
| 2967 | ;; process. We ignore errors, because the | 2956 | ;; Now do it. |
| 2968 | ;; process could have finished already. | 2957 | (if command |
| 2969 | (ignore-errors | 2958 | ;; Send the command. |
| 2970 | (set-process-query-on-exit-flag p (null noquery)) | 2959 | (tramp-send-command v command nil t) ; nooutput |
| 2971 | (set-marker (process-mark p) (point))) | 2960 | ;; Check, whether a pty is associated. |
| 2972 | ;; We must flush them here already; otherwise | 2961 | (unless (process-get p 'remote-tty) |
| 2973 | ;; `rename-file', `delete-file' or | 2962 | (tramp-error |
| 2974 | ;; `insert-file-contents' will fail. | 2963 | v 'file-error |
| 2975 | (tramp-flush-connection-property v "process-name") | 2964 | "pty association is not supported for `%s'" |
| 2976 | (tramp-flush-connection-property v "process-buffer") | 2965 | name)))) |
| 2977 | ;; Copy tmpstderr file. | 2966 | ;; Set sentinel and filter. |
| 2978 | (when (and (stringp stderr) | 2967 | (when sentinel |
| 2979 | (not (tramp-tramp-file-p stderr))) | 2968 | (set-process-sentinel p sentinel)) |
| 2980 | (add-function | 2969 | (when filter |
| 2981 | :after (process-sentinel p) | 2970 | (set-process-filter p filter)) |
| 2982 | (lambda (_proc _msg) | 2971 | ;; Set query flag and process marker for this |
| 2983 | (rename-file remote-tmpstderr stderr)))) | 2972 | ;; process. We ignore errors, because the |
| 2984 | ;; Provide error buffer. This shows only | 2973 | ;; process could have finished already. |
| 2985 | ;; initial error messages; messages arriving | 2974 | (ignore-errors |
| 2986 | ;; later on will be inserted when the process is | 2975 | (set-process-query-on-exit-flag p (null noquery)) |
| 2987 | ;; deleted. The temporary file will exist until | 2976 | (set-marker (process-mark p) (point))) |
| 2988 | ;; the process is deleted. | 2977 | ;; We must flush them here already; otherwise |
| 2989 | (when (bufferp stderr) | 2978 | ;; `rename-file', `delete-file' or |
| 2990 | (with-current-buffer stderr | 2979 | ;; `insert-file-contents' will fail. |
| 2991 | (insert-file-contents-literally remote-tmpstderr)) | 2980 | (tramp-flush-connection-property v "process-name") |
| 2992 | ;; Delete tmpstderr file. | 2981 | (tramp-flush-connection-property v "process-buffer") |
| 2993 | (add-function | 2982 | ;; Copy tmpstderr file. |
| 2994 | :after (process-sentinel p) | 2983 | (when (and (stringp stderr) |
| 2995 | (lambda (_proc _msg) | 2984 | (not (tramp-tramp-file-p stderr))) |
| 2996 | (when (file-exists-p remote-tmpstderr) | 2985 | (add-function |
| 2997 | (with-current-buffer stderr | 2986 | :after (process-sentinel p) |
| 2998 | (insert-file-contents-literally | 2987 | (lambda (_proc _msg) |
| 2999 | remote-tmpstderr nil nil nil 'replace)) | 2988 | (rename-file remote-tmpstderr stderr)))) |
| 3000 | (delete-file remote-tmpstderr))))) | 2989 | ;; Provide error buffer. This shows only |
| 3001 | ;; Return process. | 2990 | ;; initial error messages; messages arriving |
| 3002 | p))) | 2991 | ;; later on will be inserted when the process |
| 2992 | ;; is deleted. The temporary file will exist | ||
| 2993 | ;; until the process is deleted. | ||
| 2994 | (when (bufferp stderr) | ||
| 2995 | (with-current-buffer stderr | ||
| 2996 | (insert-file-contents-literally remote-tmpstderr)) | ||
| 2997 | ;; Delete tmpstderr file. | ||
| 2998 | (add-function | ||
| 2999 | :after (process-sentinel p) | ||
| 3000 | (lambda (_proc _msg) | ||
| 3001 | (when (file-exists-p remote-tmpstderr) | ||
| 3002 | (with-current-buffer stderr | ||
| 3003 | (insert-file-contents-literally | ||
| 3004 | remote-tmpstderr nil nil nil 'replace)) | ||
| 3005 | (delete-file remote-tmpstderr))))) | ||
| 3006 | ;; Return process. | ||
| 3007 | p))) | ||
| 3003 | 3008 | ||
| 3004 | ;; Save exit. | 3009 | ;; Save exit. |
| 3005 | (if (string-match-p tramp-temp-buffer-name (buffer-name)) | 3010 | (if (string-match-p tramp-temp-buffer-name (buffer-name)) |
| 3006 | (ignore-errors | 3011 | (ignore-errors |
| 3007 | (set-process-buffer p nil) | 3012 | (set-process-buffer p nil) |
| 3008 | (kill-buffer (current-buffer))) | 3013 | (kill-buffer (current-buffer))) |
| 3009 | (set-buffer-modified-p bmp)) | 3014 | (set-buffer-modified-p bmp)) |
| 3010 | (tramp-flush-connection-property v "process-name") | 3015 | (tramp-flush-connection-property v "process-name") |
| 3011 | (tramp-flush-connection-property v "process-buffer")))))))) | 3016 | (tramp-flush-connection-property v "process-buffer"))))))))) |
| 3012 | 3017 | ||
| 3013 | (defun tramp-sh-get-signal-strings (vec) | 3018 | (defun tramp-sh-get-signal-strings (vec) |
| 3014 | "Strings to return by `process-file' in case of signals." | 3019 | "Strings to return by `process-file' in case of signals." |
| @@ -3646,6 +3651,14 @@ Fall back to normal file name handler if no Tramp handler exists." | |||
| 3646 | (save-match-data (apply (cdr fn) args)) | 3651 | (save-match-data (apply (cdr fn) args)) |
| 3647 | (tramp-run-real-handler operation args))) | 3652 | (tramp-run-real-handler operation args))) |
| 3648 | 3653 | ||
| 3654 | ;;;###tramp-autoload | ||
| 3655 | (defun tramp-sh-file-name-handler-p (vec) | ||
| 3656 | "Whether VEC uses a method from `tramp-sh-file-name-handler'." | ||
| 3657 | (and (assoc (tramp-file-name-method vec) tramp-methods) | ||
| 3658 | (eq (tramp-find-foreign-file-name-handler | ||
| 3659 | (tramp-make-tramp-file-name vec nil 'nohop)) | ||
| 3660 | 'tramp-sh-file-name-handler))) | ||
| 3661 | |||
| 3649 | ;; This must be the last entry, because `identity' always matches. | 3662 | ;; This must be the last entry, because `identity' always matches. |
| 3650 | ;;;###tramp-autoload | 3663 | ;;;###tramp-autoload |
| 3651 | (tramp--with-startup | 3664 | (tramp--with-startup |
| @@ -4769,6 +4782,12 @@ Goes through the list `tramp-inline-compress-commands'." | |||
| 4769 | (tramp-message | 4782 | (tramp-message |
| 4770 | vec 2 "Couldn't find an inline transfer compress command"))))) | 4783 | vec 2 "Couldn't find an inline transfer compress command"))))) |
| 4771 | 4784 | ||
| 4785 | ;;;###tramp-autoload | ||
| 4786 | (defun tramp-multi-hop-p (vec) | ||
| 4787 | "Whether the method of VEC is capable of multi-hops." | ||
| 4788 | (and (tramp-sh-file-name-handler-p vec) | ||
| 4789 | (not (tramp-get-method-parameter vec 'tramp-copy-program)))) | ||
| 4790 | |||
| 4772 | (defun tramp-compute-multi-hops (vec) | 4791 | (defun tramp-compute-multi-hops (vec) |
| 4773 | "Expands VEC according to `tramp-default-proxies-alist'." | 4792 | "Expands VEC according to `tramp-default-proxies-alist'." |
| 4774 | (let ((saved-tdpa tramp-default-proxies-alist) | 4793 | (let ((saved-tdpa tramp-default-proxies-alist) |
| @@ -4832,8 +4851,7 @@ Goes through the list `tramp-inline-compress-commands'." | |||
| 4832 | (when (cdr target-alist) | 4851 | (when (cdr target-alist) |
| 4833 | (setq choices target-alist) | 4852 | (setq choices target-alist) |
| 4834 | (while (setq item (pop choices)) | 4853 | (while (setq item (pop choices)) |
| 4835 | (when (or (not (tramp-get-method-parameter item 'tramp-login-program)) | 4854 | (unless (tramp-multi-hop-p item) |
| 4836 | (tramp-get-method-parameter item 'tramp-copy-program)) | ||
| 4837 | (setq tramp-default-proxies-alist saved-tdpa) | 4855 | (setq tramp-default-proxies-alist saved-tdpa) |
| 4838 | (tramp-user-error | 4856 | (tramp-user-error |
| 4839 | vec "Method `%s' is not supported for multi-hops." | 4857 | vec "Method `%s' is not supported for multi-hops." |
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index c169a86f915..fdf26f6b782 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el | |||
| @@ -1482,10 +1482,7 @@ default values are used." | |||
| 1482 | (tramp-user-error | 1482 | (tramp-user-error |
| 1483 | v "Method `%s' is not known." method)) | 1483 | v "Method `%s' is not known." method)) |
| 1484 | ;; Only some methods from tramp-sh.el do support multi-hops. | 1484 | ;; Only some methods from tramp-sh.el do support multi-hops. |
| 1485 | (when (and | 1485 | (unless (or (null hop) nodefault non-essential (tramp-multi-hop-p v)) |
| 1486 | hop | ||
| 1487 | (or (not (tramp-get-method-parameter v 'tramp-login-program)) | ||
| 1488 | (tramp-get-method-parameter v 'tramp-copy-program))) | ||
| 1489 | (tramp-user-error | 1486 | (tramp-user-error |
| 1490 | v "Method `%s' is not supported for multi-hops." method))))))) | 1487 | v "Method `%s' is not supported for multi-hops." method))))))) |
| 1491 | 1488 | ||
| @@ -1499,8 +1496,7 @@ See `tramp-dissect-file-name' for details." | |||
| 1499 | tramp-postfix-host-format name)) | 1496 | tramp-postfix-host-format name)) |
| 1500 | nodefault))) | 1497 | nodefault))) |
| 1501 | ;; Only some methods from tramp-sh.el do support multi-hops. | 1498 | ;; Only some methods from tramp-sh.el do support multi-hops. |
| 1502 | (when (or (not (tramp-get-method-parameter v 'tramp-login-program)) | 1499 | (unless (or nodefault non-essential (tramp-multi-hop-p v)) |
| 1503 | (tramp-get-method-parameter v 'tramp-copy-program)) | ||
| 1504 | (tramp-user-error | 1500 | (tramp-user-error |
| 1505 | v "Method `%s' is not supported for multi-hops." | 1501 | v "Method `%s' is not supported for multi-hops." |
| 1506 | (tramp-file-name-method v))) | 1502 | (tramp-file-name-method v))) |
| @@ -3519,13 +3515,10 @@ User is always nil." | |||
| 3519 | 3515 | ||
| 3520 | ;; When we shall insert only a part of the file, we | 3516 | ;; When we shall insert only a part of the file, we |
| 3521 | ;; copy this part. This works only for the shell file | 3517 | ;; copy this part. This works only for the shell file |
| 3522 | ;; name handlers. | 3518 | ;; name handlers. It doesn't work for crypted files. |
| 3523 | (when (and (or beg end) | 3519 | (when (and (or beg end) |
| 3524 | ;; Direct actions aren't possible for | 3520 | (tramp-sh-file-name-handler-p v) |
| 3525 | ;; crypted directories. | 3521 | (null tramp-crypt-enabled)) |
| 3526 | (null tramp-crypt-enabled) | ||
| 3527 | (tramp-get-method-parameter | ||
| 3528 | v 'tramp-login-program)) | ||
| 3529 | (setq remote-copy (tramp-make-tramp-temp-file v)) | 3522 | (setq remote-copy (tramp-make-tramp-temp-file v)) |
| 3530 | ;; This is defined in tramp-sh.el. Let's assume | 3523 | ;; This is defined in tramp-sh.el. Let's assume |
| 3531 | ;; this is loaded already. | 3524 | ;; this is loaded already. |
| @@ -3640,6 +3633,152 @@ User is always nil." | |||
| 3640 | (load local-copy noerror t nosuffix must-suffix) | 3633 | (load local-copy noerror t nosuffix must-suffix) |
| 3641 | (delete-file local-copy))))) | 3634 | (delete-file local-copy))))) |
| 3642 | t))) | 3635 | t))) |
| 3636 | ;; We use BUFFER also as connection buffer during setup. Because of | ||
| 3637 | ;; this, its original contents must be saved, and restored once | ||
| 3638 | ;; connection has been setup. | ||
| 3639 | (defun tramp-handle-make-process (&rest args) | ||
| 3640 | "An alternative `make-process' implementation for Tramp files." | ||
| 3641 | (when args | ||
| 3642 | (with-parsed-tramp-file-name (expand-file-name default-directory) nil | ||
| 3643 | (let ((name (plist-get args :name)) | ||
| 3644 | (buffer (plist-get args :buffer)) | ||
| 3645 | (command (plist-get args :command)) | ||
| 3646 | (coding (plist-get args :coding)) | ||
| 3647 | (noquery (plist-get args :noquery)) | ||
| 3648 | (connection-type (plist-get args :connection-type)) | ||
| 3649 | (filter (plist-get args :filter)) | ||
| 3650 | (sentinel (plist-get args :sentinel)) | ||
| 3651 | (stderr (plist-get args :stderr))) | ||
| 3652 | (unless (stringp name) | ||
| 3653 | (signal 'wrong-type-argument (list #'stringp name))) | ||
| 3654 | (unless (or (null buffer) (bufferp buffer) (stringp buffer)) | ||
| 3655 | (signal 'wrong-type-argument (list #'stringp buffer))) | ||
| 3656 | (unless (consp command) | ||
| 3657 | (signal 'wrong-type-argument (list #'consp command))) | ||
| 3658 | (unless (or (null coding) | ||
| 3659 | (and (symbolp coding) (memq coding coding-system-list)) | ||
| 3660 | (and (consp coding) | ||
| 3661 | (memq (car coding) coding-system-list) | ||
| 3662 | (memq (cdr coding) coding-system-list))) | ||
| 3663 | (signal 'wrong-type-argument (list #'symbolp coding))) | ||
| 3664 | (unless (or (null connection-type) (memq connection-type '(pipe pty))) | ||
| 3665 | (signal 'wrong-type-argument (list #'symbolp connection-type))) | ||
| 3666 | (unless (or (null filter) (functionp filter)) | ||
| 3667 | (signal 'wrong-type-argument (list #'functionp filter))) | ||
| 3668 | (unless (or (null sentinel) (functionp sentinel)) | ||
| 3669 | (signal 'wrong-type-argument (list #'functionp sentinel))) | ||
| 3670 | (unless (or (null stderr) (bufferp stderr) (stringp stderr)) | ||
| 3671 | (signal 'wrong-type-argument (list #'stringp stderr))) | ||
| 3672 | (when (and (stringp stderr) (tramp-tramp-file-p stderr) | ||
| 3673 | (not (tramp-equal-remote default-directory stderr))) | ||
| 3674 | (signal 'file-error (list "Wrong stderr" stderr))) | ||
| 3675 | |||
| 3676 | (let* ((buffer | ||
| 3677 | (if buffer | ||
| 3678 | (get-buffer-create buffer) | ||
| 3679 | ;; BUFFER can be nil. We use a temporary buffer. | ||
| 3680 | (generate-new-buffer tramp-temp-buffer-name))) | ||
| 3681 | (command (append `("cd" ,localname "&&") | ||
| 3682 | (mapcar #'tramp-shell-quote-argument command))) | ||
| 3683 | (bmp (and (buffer-live-p buffer) (buffer-modified-p buffer))) | ||
| 3684 | (name1 name) | ||
| 3685 | (i 0) | ||
| 3686 | ;; We do not want to raise an error when `make-process' | ||
| 3687 | ;; has been started several times in `eshell' and | ||
| 3688 | ;; friends. | ||
| 3689 | tramp-current-connection | ||
| 3690 | p) | ||
| 3691 | |||
| 3692 | (while (get-process name1) | ||
| 3693 | ;; NAME must be unique as process name. | ||
| 3694 | (setq i (1+ i) | ||
| 3695 | name1 (format "%s<%d>" name i))) | ||
| 3696 | (setq name name1) | ||
| 3697 | ;; Set the new process properties. | ||
| 3698 | (tramp-set-connection-property v "process-name" name) | ||
| 3699 | (tramp-set-connection-property v "process-buffer" buffer) | ||
| 3700 | |||
| 3701 | (with-current-buffer (tramp-get-connection-buffer v) | ||
| 3702 | (unwind-protect | ||
| 3703 | (let* ((login-program | ||
| 3704 | (tramp-get-method-parameter v 'tramp-login-program)) | ||
| 3705 | (login-args | ||
| 3706 | (tramp-get-method-parameter v 'tramp-login-args)) | ||
| 3707 | (async-args | ||
| 3708 | (tramp-get-method-parameter v 'tramp-async-args)) | ||
| 3709 | ;; We don't create the temporary file. In | ||
| 3710 | ;; fact, it is just a prefix for the | ||
| 3711 | ;; ControlPath option of ssh; the real | ||
| 3712 | ;; temporary file has another name, and it is | ||
| 3713 | ;; created and protected by ssh. It is also | ||
| 3714 | ;; removed by ssh when the connection is | ||
| 3715 | ;; closed. The temporary file name is cached | ||
| 3716 | ;; in the main connection process, therefore | ||
| 3717 | ;; we cannot use `tramp-get-connection-process'. | ||
| 3718 | (tmpfile | ||
| 3719 | (when (tramp-sh-file-name-handler-p v) | ||
| 3720 | (with-tramp-connection-property | ||
| 3721 | (tramp-get-process v) "temp-file" | ||
| 3722 | (tramp-compat-make-temp-name)))) | ||
| 3723 | (options | ||
| 3724 | (when (tramp-sh-file-name-handler-p v) | ||
| 3725 | (tramp-compat-funcall | ||
| 3726 | 'tramp-ssh-controlmaster-options v))) | ||
| 3727 | spec) | ||
| 3728 | |||
| 3729 | ;; Replace `login-args' place holders. | ||
| 3730 | (setq | ||
| 3731 | spec (format-spec-make ?t tmpfile) | ||
| 3732 | options (format-spec (or options "") spec) | ||
| 3733 | spec (format-spec-make | ||
| 3734 | ?h (or host "") ?u (or user "") ?p (or port "") | ||
| 3735 | ?c options ?l "") | ||
| 3736 | ;; Add arguments for asynchronous processes. | ||
| 3737 | login-args (append async-args login-args) | ||
| 3738 | ;; Expand format spec. | ||
| 3739 | login-args | ||
| 3740 | (tramp-compat-flatten-tree | ||
| 3741 | (mapcar | ||
| 3742 | (lambda (x) | ||
| 3743 | (setq x (mapcar (lambda (y) (format-spec y spec)) x)) | ||
| 3744 | (unless (member "" x) x)) | ||
| 3745 | login-args)) | ||
| 3746 | ;; Split ControlMaster options. | ||
| 3747 | login-args | ||
| 3748 | (tramp-compat-flatten-tree | ||
| 3749 | (mapcar (lambda (x) (split-string x " ")) login-args)) | ||
| 3750 | p (apply | ||
| 3751 | #'start-process | ||
| 3752 | name buffer login-program (append login-args command))) | ||
| 3753 | |||
| 3754 | (tramp-message v 6 "%s" (string-join (process-command p) " ")) | ||
| 3755 | ;; Set sentinel and filter. | ||
| 3756 | (when sentinel | ||
| 3757 | (set-process-sentinel p sentinel)) | ||
| 3758 | (when filter | ||
| 3759 | (set-process-filter p filter)) | ||
| 3760 | ;; Set query flag and process marker for this | ||
| 3761 | ;; process. We ignore errors, because the | ||
| 3762 | ;; process could have finished already. | ||
| 3763 | (ignore-errors | ||
| 3764 | (set-process-query-on-exit-flag p (null noquery)) | ||
| 3765 | (set-marker (process-mark p) (point))) | ||
| 3766 | ;; We must flush them here already; otherwise | ||
| 3767 | ;; `rename-file', `delete-file' or | ||
| 3768 | ;; `insert-file-contents' will fail. | ||
| 3769 | (tramp-flush-connection-property v "process-name") | ||
| 3770 | (tramp-flush-connection-property v "process-buffer") | ||
| 3771 | ;; Return process. | ||
| 3772 | p) | ||
| 3773 | |||
| 3774 | ;; Save exit. | ||
| 3775 | (if (string-match-p tramp-temp-buffer-name (buffer-name)) | ||
| 3776 | (ignore-errors | ||
| 3777 | (set-process-buffer p nil) | ||
| 3778 | (kill-buffer (current-buffer))) | ||
| 3779 | (set-buffer-modified-p bmp)) | ||
| 3780 | (tramp-flush-connection-property v "process-name") | ||
| 3781 | (tramp-flush-connection-property v "process-buffer")))))))) | ||
| 3643 | 3782 | ||
| 3644 | (defun tramp-handle-make-symbolic-link | 3783 | (defun tramp-handle-make-symbolic-link |
| 3645 | (target linkname &optional ok-if-already-exists) | 3784 | (target linkname &optional ok-if-already-exists) |
| @@ -3676,8 +3815,8 @@ support symbolic links." | |||
| 3676 | (current-buffer)) | 3815 | (current-buffer)) |
| 3677 | (t (get-buffer-create | 3816 | (t (get-buffer-create |
| 3678 | (if asynchronous | 3817 | (if asynchronous |
| 3679 | "*Async Shell Command*" | 3818 | shell-command-buffer-name-async |
| 3680 | "*Shell Command Output*"))))) | 3819 | shell-command-buffer-name))))) |
| 3681 | (error-buffer | 3820 | (error-buffer |
| 3682 | (cond | 3821 | (cond |
| 3683 | ((bufferp error-buffer) error-buffer) | 3822 | ((bufferp error-buffer) error-buffer) |
| @@ -4706,7 +4845,7 @@ This handles also chrooted environments, which are not regarded as local." | |||
| 4706 | ;; The method shall be applied to one of the shell file name | 4845 | ;; The method shall be applied to one of the shell file name |
| 4707 | ;; handlers. `tramp-local-host-p' is also called for "smb" and | 4846 | ;; handlers. `tramp-local-host-p' is also called for "smb" and |
| 4708 | ;; alike, where it must fail. | 4847 | ;; alike, where it must fail. |
| 4709 | (tramp-get-method-parameter vec 'tramp-login-program) | 4848 | (tramp-sh-file-name-handler-p vec) |
| 4710 | ;; Direct actions aren't possible for crypted directories. | 4849 | ;; Direct actions aren't possible for crypted directories. |
| 4711 | (null tramp-crypt-enabled) | 4850 | (null tramp-crypt-enabled) |
| 4712 | ;; The local temp directory must be writable for the other user. | 4851 | ;; The local temp directory must be writable for the other user. |
diff --git a/lisp/outline.el b/lisp/outline.el index 28ea8a86e6f..6158ed594e9 100644 --- a/lisp/outline.el +++ b/lisp/outline.el | |||
| @@ -289,12 +289,19 @@ Turning on outline mode calls the value of `text-mode-hook' and then of | |||
| 289 | (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) | 289 | (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) |
| 290 | (add-hook 'change-major-mode-hook 'outline-show-all nil t)) | 290 | (add-hook 'change-major-mode-hook 'outline-show-all nil t)) |
| 291 | 291 | ||
| 292 | (defvar outline-minor-mode-map) | ||
| 293 | |||
| 292 | (defcustom outline-minor-mode-prefix "\C-c@" | 294 | (defcustom outline-minor-mode-prefix "\C-c@" |
| 293 | "Prefix key to use for Outline commands in Outline minor mode. | 295 | "Prefix key to use for Outline commands in Outline minor mode. |
| 294 | The value of this variable is checked as part of loading Outline mode. | 296 | The value of this variable is checked as part of loading Outline mode. |
| 295 | After that, changing the prefix key requires manipulating keymaps." | 297 | After that, changing the prefix key requires manipulating keymaps." |
| 296 | :type 'string | 298 | :type 'key-sequence |
| 297 | :group 'outlines) | 299 | :group 'outlines |
| 300 | :initialize 'custom-initialize-default | ||
| 301 | :set (lambda (sym val) | ||
| 302 | (define-key outline-minor-mode-map outline-minor-mode-prefix nil) | ||
| 303 | (define-key outline-minor-mode-map val outline-mode-prefix-map) | ||
| 304 | (set-default sym val))) | ||
| 298 | 305 | ||
| 299 | ;;;###autoload | 306 | ;;;###autoload |
| 300 | (define-minor-mode outline-minor-mode | 307 | (define-minor-mode outline-minor-mode |
diff --git a/lisp/play/snake.el b/lisp/play/snake.el index d7c0683a05f..70d80c464fc 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el | |||
| @@ -192,6 +192,7 @@ and then start moving it leftwards.") | |||
| 192 | (defvar snake-null-map | 192 | (defvar snake-null-map |
| 193 | (let ((map (make-sparse-keymap 'snake-null-map))) | 193 | (let ((map (make-sparse-keymap 'snake-null-map))) |
| 194 | (define-key map "n" 'snake-start-game) | 194 | (define-key map "n" 'snake-start-game) |
| 195 | (define-key map "q" 'quit-window) | ||
| 195 | map) | 196 | map) |
| 196 | "Keymap for finished Snake games.") | 197 | "Keymap for finished Snake games.") |
| 197 | 198 | ||
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index cdbb59a5add..6122caf5189 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el | |||
| @@ -3560,19 +3560,18 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3560 | "\\(\\`\n?\\|^\n\\)=" ; POD | 3560 | "\\(\\`\n?\\|^\n\\)=" ; POD |
| 3561 | "\\|" | 3561 | "\\|" |
| 3562 | ;; One extra () before this: | 3562 | ;; One extra () before this: |
| 3563 | "<<~?" ; HERE-DOC | 3563 | "<<\\(~?\\)" ; HERE-DOC, indented-p = capture 2 |
| 3564 | "\\(" ; 1 + 1 | 3564 | "\\(" ; 2 + 1 |
| 3565 | ;; First variant "BLAH" or just ``. | 3565 | ;; First variant "BLAH" or just ``. |
| 3566 | "[ \t]*" ; Yes, whitespace is allowed! | 3566 | "[ \t]*" ; Yes, whitespace is allowed! |
| 3567 | "\\([\"'`]\\)" ; 2 + 1 = 3 | 3567 | "\\([\"'`]\\)" ; 3 + 1 = 4 |
| 3568 | "\\([^\"'`\n]*\\)" ; 3 + 1 | 3568 | "\\([^\"'`\n]*\\)" ; 4 + 1 |
| 3569 | "\\3" | 3569 | "\\4" |
| 3570 | "\\|" | 3570 | "\\|" |
| 3571 | ;; Second variant: Identifier or \ID (same as 'ID') or empty | 3571 | ;; Second variant: Identifier or \ID (same as 'ID') or empty |
| 3572 | "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 4 + 1, 5 + 1 | 3572 | "\\\\?\\(\\([a-zA-Z_][a-zA-Z_0-9]*\\)?\\)" ; 5 + 1, 6 + 1 |
| 3573 | ;; Do not have <<= or << 30 or <<30 or << $blah. | 3573 | ;; Do not have <<= or << 30 or <<30 or << $blah. |
| 3574 | ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 | 3574 | ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 |
| 3575 | "\\(\\)" ; To preserve count of pars :-( 6 + 1 | ||
| 3576 | "\\)" | 3575 | "\\)" |
| 3577 | "\\|" | 3576 | "\\|" |
| 3578 | ;; 1+6 extra () before this: | 3577 | ;; 1+6 extra () before this: |
| @@ -3762,11 +3761,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3762 | ;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 | 3761 | ;; ;; "\\([^= \t0-9$@%&]\\|[ \t]+[^ \t\n0-9$@%&]\\)" ; 6 + 1 |
| 3763 | ;; "\\(\\)" ; To preserve count of pars :-( 6 + 1 | 3762 | ;; "\\(\\)" ; To preserve count of pars :-( 6 + 1 |
| 3764 | ;; "\\)" | 3763 | ;; "\\)" |
| 3765 | ((match-beginning 2) ; 1 + 1 | 3764 | ((match-beginning 3) ; 2 + 1 |
| 3766 | (setq b (point) | 3765 | (setq b (point) |
| 3767 | tb (match-beginning 0) | 3766 | tb (match-beginning 0) |
| 3768 | c (and ; not HERE-DOC | 3767 | c (and ; not HERE-DOC |
| 3769 | (match-beginning 5) | 3768 | (match-beginning 6) |
| 3770 | (save-match-data | 3769 | (save-match-data |
| 3771 | (or (looking-at "[ \t]*(") ; << function_call() | 3770 | (or (looking-at "[ \t]*(") ; << function_call() |
| 3772 | (save-excursion ; 1 << func_name, or $foo << 10 | 3771 | (save-excursion ; 1 << func_name, or $foo << 10 |
| @@ -3793,17 +3792,17 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3793 | (looking-at "\\(printf?\\|say\\|system\\|exec\\|sort\\)\\>"))) | 3792 | (looking-at "\\(printf?\\|say\\|system\\|exec\\|sort\\)\\>"))) |
| 3794 | (error t))))))) | 3793 | (error t))))))) |
| 3795 | (error nil))) ; func(<<EOF) | 3794 | (error nil))) ; func(<<EOF) |
| 3796 | (and (not (match-beginning 6)) ; Empty | 3795 | (and (not (match-beginning 7)) ; Empty |
| 3797 | (looking-at | 3796 | (looking-at |
| 3798 | "[ \t]*[=0-9$@%&(]")))))) | 3797 | "[ \t]*[=0-9$@%&(]")))))) |
| 3799 | (if c ; Not here-doc | 3798 | (if c ; Not here-doc |
| 3800 | nil ; Skip it. | 3799 | nil ; Skip it. |
| 3801 | (setq c (match-end 2)) ; 1 + 1 | 3800 | (setq c (match-end 3)) ; 2 + 1 |
| 3802 | (if (match-beginning 5) ;4 + 1 | 3801 | (if (match-beginning 6) ;6 + 1 |
| 3803 | (setq b1 (match-beginning 5) ; 4 + 1 | 3802 | (setq b1 (match-beginning 6) ; 5 + 1 |
| 3804 | e1 (match-end 5)) ; 4 + 1 | 3803 | e1 (match-end 6)) ; 5 + 1 |
| 3805 | (setq b1 (match-beginning 4) ; 3 + 1 | 3804 | (setq b1 (match-beginning 5) ; 4 + 1 |
| 3806 | e1 (match-end 4))) ; 3 + 1 | 3805 | e1 (match-end 5))) ; 4 + 1 |
| 3807 | (setq tag (buffer-substring b1 e1) | 3806 | (setq tag (buffer-substring b1 e1) |
| 3808 | qtag (regexp-quote tag)) | 3807 | qtag (regexp-quote tag)) |
| 3809 | (cond (cperl-pod-here-fontify | 3808 | (cond (cperl-pod-here-fontify |
| @@ -3818,8 +3817,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face', | |||
| 3818 | (setq b (point)) | 3817 | (setq b (point)) |
| 3819 | ;; We do not search to max, since we may be called from | 3818 | ;; We do not search to max, since we may be called from |
| 3820 | ;; some hook of fontification, and max is random | 3819 | ;; some hook of fontification, and max is random |
| 3821 | (or (and (re-search-forward (concat "^[ \t]*" qtag "$") | 3820 | (or (and (re-search-forward |
| 3822 | stop-point 'toend) | 3821 | (concat "^" (when (equal (match-string 2) "~") "[ \t]*") |
| 3822 | qtag "$") | ||
| 3823 | stop-point 'toend) | ||
| 3823 | ;;;(eq (following-char) ?\n) ; XXXX WHY??? | 3824 | ;;;(eq (following-char) ?\n) ; XXXX WHY??? |
| 3824 | ) | 3825 | ) |
| 3825 | (progn ; Pretend we matched at the end | 3826 | (progn ; Pretend we matched at the end |
| @@ -5752,7 +5753,7 @@ indentation and initial hashes. Behaves usually outside of comment." | |||
| 5752 | (if (eq (char-after (match-beginning 2)) ?%) | 5753 | (if (eq (char-after (match-beginning 2)) ?%) |
| 5753 | 'cperl-hash-face | 5754 | 'cperl-hash-face |
| 5754 | 'cperl-array-face) | 5755 | 'cperl-array-face) |
| 5755 | t) ; arrays and hashes | 5756 | nil) ; arrays and hashes |
| 5756 | ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" | 5757 | ("\\(\\([$@]+\\)[a-zA-Z_:][a-zA-Z0-9_:]*\\)[ \t]*\\([[{]\\)" |
| 5757 | 1 | 5758 | 1 |
| 5758 | (if (= (- (match-end 2) (match-beginning 2)) 1) | 5759 | (if (= (- (match-end 2) (match-beginning 2)) 1) |
| @@ -6499,9 +6500,10 @@ If optional argument ALL is `recursive', will process Perl files | |||
| 6499 | in subdirectories too." | 6500 | in subdirectories too." |
| 6500 | (interactive) | 6501 | (interactive) |
| 6501 | (let ((cmd "etags") | 6502 | (let ((cmd "etags") |
| 6502 | (args '("-l" "none" "-r" | 6503 | (args `("-l" "none" "-r" |
| 6503 | ;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!) | 6504 | ;; 1=fullname 2=package? 3=name 4=proto? 5=attrs? (VERY APPROX!) |
| 6504 | "/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/" | 6505 | ,(concat |
| 6506 | "/\\<" cperl-sub-regexp "[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\(([^()]*)[ \t]*\\)?\\([ \t]*:[^#{;]*\\)?\\([{#]\\|$\\)/\\3/") | ||
| 6505 | "-r" | 6507 | "-r" |
| 6506 | "/\\<package[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\([#;]\\|$\\)/\\1/" | 6508 | "/\\<package[ \\t]+\\(\\([a-zA-Z0-9:_]*::\\)?\\([a-zA-Z0-9_]+\\)\\)[ \\t]*\\([#;]\\|$\\)/\\1/" |
| 6507 | "-r" | 6509 | "-r" |
| @@ -6786,6 +6788,7 @@ Use as | |||
| 6786 | (or topdir | 6788 | (or topdir |
| 6787 | (setq topdir default-directory)) | 6789 | (setq topdir default-directory)) |
| 6788 | (let ((tags-file-name "TAGS") | 6790 | (let ((tags-file-name "TAGS") |
| 6791 | (inhibit-read-only t) | ||
| 6789 | (case-fold-search nil) | 6792 | (case-fold-search nil) |
| 6790 | xs rel) | 6793 | xs rel) |
| 6791 | (save-excursion | 6794 | (save-excursion |
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index 51b9347bb93..b6161351f0b 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el | |||
| @@ -1166,7 +1166,9 @@ Save the result in `project-list-file' if the list of projects has changed." | |||
| 1166 | (project--ensure-read-project-list) | 1166 | (project--ensure-read-project-list) |
| 1167 | (let ((dir (project-root pr))) | 1167 | (let ((dir (project-root pr))) |
| 1168 | (unless (equal (caar project--list) dir) | 1168 | (unless (equal (caar project--list) dir) |
| 1169 | (setq project--list (assoc-delete-all dir project--list)) | 1169 | (dolist (ent project--list) |
| 1170 | (when (equal dir (car ent)) | ||
| 1171 | (setq project--list (delq ent project--list)))) | ||
| 1170 | (push (list dir) project--list) | 1172 | (push (list dir) project--list) |
| 1171 | (project--write-project-list)))) | 1173 | (project--write-project-list)))) |
| 1172 | 1174 | ||
| @@ -1176,8 +1178,8 @@ If the directory was in the list before the removal, save the | |||
| 1176 | result in `project-list-file'. Announce the project's removal | 1178 | result in `project-list-file'. Announce the project's removal |
| 1177 | from the list." | 1179 | from the list." |
| 1178 | (project--ensure-read-project-list) | 1180 | (project--ensure-read-project-list) |
| 1179 | (when (assoc pr-dir project--list) | 1181 | (when-let ((ent (assoc pr-dir project--list))) |
| 1180 | (setq project--list (assoc-delete-all pr-dir project--list)) | 1182 | (setq project--list (delq ent project--list)) |
| 1181 | (message "Project `%s' not found; removed from list" pr-dir) | 1183 | (message "Project `%s' not found; removed from list" pr-dir) |
| 1182 | (project--write-project-list))) | 1184 | (project--write-project-list))) |
| 1183 | 1185 | ||
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 044d7820ee3..5a47594878e 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el | |||
| @@ -838,7 +838,7 @@ See `sh-feature'.") | |||
| 838 | font-lock-variable-name-face)) | 838 | font-lock-variable-name-face)) |
| 839 | 839 | ||
| 840 | (rc sh-append es) | 840 | (rc sh-append es) |
| 841 | (bash sh-append sh ("\\$(\\(\\sw+\\)" (1 'sh-quoted-exec t) )) | 841 | (bash sh-append sh ("\\$(\\([^)\n]+\\)" (1 'sh-quoted-exec t) )) |
| 842 | (sh sh-append shell | 842 | (sh sh-append shell |
| 843 | ;; Variable names. | 843 | ;; Variable names. |
| 844 | ("\\$\\({#?\\)?\\([[:alpha:]_][[:alnum:]_]*\\|[-#?@!]\\)" 2 | 844 | ("\\$\\({#?\\)?\\([[:alpha:]_][[:alnum:]_]*\\|[-#?@!]\\)" 2 |
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index c86fc59ac16..a70b5ed60d6 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el | |||
| @@ -1508,6 +1508,22 @@ Based on `comint-mode-map'.") | |||
| 1508 | table) | 1508 | table) |
| 1509 | "Syntax table used in `sql-mode' and `sql-interactive-mode'.") | 1509 | "Syntax table used in `sql-mode' and `sql-interactive-mode'.") |
| 1510 | 1510 | ||
| 1511 | ;;; Syntax Properties | ||
| 1512 | |||
| 1513 | ;; `sql--syntax-propertize-escaped-apostrophe', as follows, was | ||
| 1514 | ;; (analysed and) adapted from `pascal--syntax-propertize' in | ||
| 1515 | ;; pascal.el because basic syntax parsing cannot handle the SQL '' | ||
| 1516 | ;; construct within strings. | ||
| 1517 | |||
| 1518 | (defconst sql--syntax-propertize-escaped-apostrophe | ||
| 1519 | (syntax-propertize-rules | ||
| 1520 | ("''" | ||
| 1521 | (0 | ||
| 1522 | (if (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) | ||
| 1523 | (string-to-syntax ".") | ||
| 1524 | (forward-char -1) | ||
| 1525 | nil))))) | ||
| 1526 | |||
| 1511 | ;; Font lock support | 1527 | ;; Font lock support |
| 1512 | 1528 | ||
| 1513 | (defvar sql-mode-font-lock-object-name | 1529 | (defvar sql-mode-font-lock-object-name |
| @@ -4210,6 +4226,10 @@ must tell Emacs. Here's how to do that in your init file: | |||
| 4210 | (setq-local abbrev-all-caps 1) | 4226 | (setq-local abbrev-all-caps 1) |
| 4211 | ;; Contains the name of database objects | 4227 | ;; Contains the name of database objects |
| 4212 | (set (make-local-variable 'sql-contains-names) t) | 4228 | (set (make-local-variable 'sql-contains-names) t) |
| 4229 | ;; Activate punctuation syntax table property for | ||
| 4230 | ;; escaped apostrophes within strings: | ||
| 4231 | (setq-local syntax-propertize-function | ||
| 4232 | sql--syntax-propertize-escaped-apostrophe) | ||
| 4213 | ;; Set syntax and font-face highlighting | 4233 | ;; Set syntax and font-face highlighting |
| 4214 | ;; Catch changes to sql-product and highlight accordingly | 4234 | ;; Catch changes to sql-product and highlight accordingly |
| 4215 | (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591 | 4235 | (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591 |
diff --git a/lisp/recentf.el b/lisp/recentf.el index 27918a9739c..877edd4be1f 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el | |||
| @@ -1289,7 +1289,8 @@ Write data into the file specified by `recentf-save-file'." | |||
| 1289 | (insert "\n\n;; Local Variables:\n" | 1289 | (insert "\n\n;; Local Variables:\n" |
| 1290 | (format ";; coding: %s\n" recentf-save-file-coding-system) | 1290 | (format ";; coding: %s\n" recentf-save-file-coding-system) |
| 1291 | ";; End:\n") | 1291 | ";; End:\n") |
| 1292 | (write-file (expand-file-name recentf-save-file)) | 1292 | (write-region (point-min) (point-max) |
| 1293 | (expand-file-name recentf-save-file)) | ||
| 1293 | (when recentf-save-file-modes | 1294 | (when recentf-save-file-modes |
| 1294 | (set-file-modes recentf-save-file recentf-save-file-modes)) | 1295 | (set-file-modes recentf-save-file recentf-save-file-modes)) |
| 1295 | nil) | 1296 | nil) |
diff --git a/lisp/saveplace.el b/lisp/saveplace.el index 46738ab03dc..d420bfb4e9f 100644 --- a/lisp/saveplace.el +++ b/lisp/saveplace.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; saveplace.el --- automatically save place in files | 1 | ;;; saveplace.el --- automatically save place in files -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1993-1994, 2001-2020 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -42,7 +42,6 @@ | |||
| 42 | "Automatically save place in files." | 42 | "Automatically save place in files." |
| 43 | :group 'data) | 43 | :group 'data) |
| 44 | 44 | ||
| 45 | |||
| 46 | (defvar save-place-alist nil | 45 | (defvar save-place-alist nil |
| 47 | "Alist of saved places to go back to when revisiting files. | 46 | "Alist of saved places to go back to when revisiting files. |
| 48 | Each element looks like (FILENAME . POSITION); | 47 | Each element looks like (FILENAME . POSITION); |
| @@ -175,10 +174,11 @@ file: | |||
| 175 | (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) | 174 | (declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) |
| 176 | 175 | ||
| 177 | (defun save-place-to-alist () | 176 | (defun save-place-to-alist () |
| 178 | ;; put filename and point in a cons box and then cons that onto the | 177 | "Add current buffer filename and position to `save-place-alist'. |
| 179 | ;; front of the save-place-alist, if save-place-mode is non-nil. | 178 | Put filename and point in a cons box and then cons that onto the |
| 180 | ;; Otherwise, just delete that file from the alist. | 179 | front of the `save-place-alist', if `save-place-mode' is non-nil. |
| 181 | ;; first check to make sure alist has been loaded in from the master | 180 | Otherwise, just delete that file from the alist." |
| 181 | ;; First check to make sure alist has been loaded in from the master | ||
| 182 | ;; file. If not, do so, then feel free to modify the alist. It | 182 | ;; file. If not, do so, then feel free to modify the alist. It |
| 183 | ;; will be saved again when Emacs is killed. | 183 | ;; will be saved again when Emacs is killed. |
| 184 | (or save-place-loaded (load-save-place-alist-from-file)) | 184 | (or save-place-loaded (load-save-place-alist-from-file)) |
diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el index 3a6d9d36429..f20ea1bcc87 100644 --- a/lisp/scroll-lock.el +++ b/lisp/scroll-lock.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; scroll-lock.el --- Scroll lock scrolling. | 1 | ;;; scroll-lock.el --- Scroll lock scrolling. -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2005-2020 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2005-2020 Free Software Foundation, Inc. |
| 4 | 4 | ||
diff --git a/lisp/simple.el b/lisp/simple.el index 2f92238e640..6c9584aaa39 100644 --- a/lisp/simple.el +++ b/lisp/simple.el | |||
| @@ -3369,6 +3369,14 @@ which is defined in the `warnings' library.\n") | |||
| 3369 | (setq buffer-undo-list nil) | 3369 | (setq buffer-undo-list nil) |
| 3370 | t)) | 3370 | t)) |
| 3371 | 3371 | ||
| 3372 | ;;;; Shell commands | ||
| 3373 | |||
| 3374 | (defconst shell-command-buffer-name "*Shell Command Output*" | ||
| 3375 | "Name of the output buffer for shell commands.") | ||
| 3376 | |||
| 3377 | (defconst shell-command-buffer-name-async "*Async Shell Command*" | ||
| 3378 | "Name of the output buffer for asynchronous shell commands.") | ||
| 3379 | |||
| 3372 | (defvar shell-command-history nil | 3380 | (defvar shell-command-history nil |
| 3373 | "History list for some commands that read shell commands. | 3381 | "History list for some commands that read shell commands. |
| 3374 | 3382 | ||
| @@ -3433,7 +3441,7 @@ to `shell-command-history'." | |||
| 3433 | (defcustom async-shell-command-buffer 'confirm-new-buffer | 3441 | (defcustom async-shell-command-buffer 'confirm-new-buffer |
| 3434 | "What to do when the output buffer is used by another shell command. | 3442 | "What to do when the output buffer is used by another shell command. |
| 3435 | This option specifies how to resolve the conflict where a new command | 3443 | This option specifies how to resolve the conflict where a new command |
| 3436 | wants to direct its output to the buffer `*Async Shell Command*', | 3444 | wants to direct its output to the buffer `shell-command-buffer-name-async', |
| 3437 | but this buffer is already taken by another running shell command. | 3445 | but this buffer is already taken by another running shell command. |
| 3438 | 3446 | ||
| 3439 | The value `confirm-kill-process' is used to ask for confirmation before | 3447 | The value `confirm-kill-process' is used to ask for confirmation before |
| @@ -3585,14 +3593,14 @@ whose `car' is BUFFER." | |||
| 3585 | Like `shell-command', but adds `&' at the end of COMMAND | 3593 | Like `shell-command', but adds `&' at the end of COMMAND |
| 3586 | to execute it asynchronously. | 3594 | to execute it asynchronously. |
| 3587 | 3595 | ||
| 3588 | The output appears in the buffer `*Async Shell Command*'. | 3596 | The output appears in the buffer `shell-command-buffer-name-async'. |
| 3589 | That buffer is in shell mode. | 3597 | That buffer is in shell mode. |
| 3590 | 3598 | ||
| 3591 | You can configure `async-shell-command-buffer' to specify what to do | 3599 | You can configure `async-shell-command-buffer' to specify what to do |
| 3592 | when the `*Async Shell Command*' buffer is already taken by another | 3600 | when the `shell-command-buffer-name-async' buffer is already taken by another |
| 3593 | running shell command. To run COMMAND without displaying the output | 3601 | running shell command. To run COMMAND without displaying the output |
| 3594 | in a window you can configure `display-buffer-alist' to use the action | 3602 | in a window you can configure `display-buffer-alist' to use the action |
| 3595 | `display-buffer-no-window' for the buffer `*Async Shell Command*'. | 3603 | `display-buffer-no-window' for the buffer `shell-command-buffer-name-async'. |
| 3596 | 3604 | ||
| 3597 | In Elisp, you will often be better served by calling `start-process' | 3605 | In Elisp, you will often be better served by calling `start-process' |
| 3598 | directly, since it offers more control and does not impose the use of | 3606 | directly, since it offers more control and does not impose the use of |
| @@ -3628,12 +3636,12 @@ If `shell-command-prompt-show-cwd' is non-nil, show the current | |||
| 3628 | directory in the prompt. | 3636 | directory in the prompt. |
| 3629 | 3637 | ||
| 3630 | If COMMAND ends in `&', execute it asynchronously. | 3638 | If COMMAND ends in `&', execute it asynchronously. |
| 3631 | The output appears in the buffer `*Async Shell Command*'. | 3639 | The output appears in the buffer `shell-command-buffer-name-async'. |
| 3632 | That buffer is in shell mode. You can also use | 3640 | That buffer is in shell mode. You can also use |
| 3633 | `async-shell-command' that automatically adds `&'. | 3641 | `async-shell-command' that automatically adds `&'. |
| 3634 | 3642 | ||
| 3635 | Otherwise, COMMAND is executed synchronously. The output appears in | 3643 | Otherwise, COMMAND is executed synchronously. The output appears in |
| 3636 | the buffer `*Shell Command Output*'. If the output is short enough to | 3644 | the buffer `shell-command-buffer-name'. If the output is short enough to |
| 3637 | display in the echo area (which is determined by the variables | 3645 | display in the echo area (which is determined by the variables |
| 3638 | `resize-mini-windows' and `max-mini-window-height'), it is shown | 3646 | `resize-mini-windows' and `max-mini-window-height'), it is shown |
| 3639 | there, but it is nonetheless available in buffer `*Shell Command | 3647 | there, but it is nonetheless available in buffer `*Shell Command |
| @@ -3756,7 +3764,7 @@ impose the use of a shell (with its need to quote arguments)." | |||
| 3756 | (if (string-match "[ \t]*&[ \t]*\\'" command) | 3764 | (if (string-match "[ \t]*&[ \t]*\\'" command) |
| 3757 | ;; Command ending with ampersand means asynchronous. | 3765 | ;; Command ending with ampersand means asynchronous. |
| 3758 | (let* ((buffer (get-buffer-create | 3766 | (let* ((buffer (get-buffer-create |
| 3759 | (or output-buffer "*Async Shell Command*"))) | 3767 | (or output-buffer shell-command-buffer-name-async))) |
| 3760 | (bname (buffer-name buffer)) | 3768 | (bname (buffer-name buffer)) |
| 3761 | (proc (get-buffer-process buffer)) | 3769 | (proc (get-buffer-process buffer)) |
| 3762 | (directory default-directory)) | 3770 | (directory default-directory)) |
| @@ -3908,7 +3916,7 @@ and are used only if a pop-up buffer is displayed." | |||
| 3908 | error-buffer display-error-buffer | 3916 | error-buffer display-error-buffer |
| 3909 | region-noncontiguous-p) | 3917 | region-noncontiguous-p) |
| 3910 | "Execute string COMMAND in inferior shell with region as input. | 3918 | "Execute string COMMAND in inferior shell with region as input. |
| 3911 | Normally display output (if any) in temp buffer `*Shell Command Output*'; | 3919 | Normally display output (if any) in temp buffer `shell-command-buffer-name'; |
| 3912 | Prefix arg means replace the region with it. Return the exit code of | 3920 | Prefix arg means replace the region with it. Return the exit code of |
| 3913 | COMMAND. | 3921 | COMMAND. |
| 3914 | 3922 | ||
| @@ -3927,7 +3935,7 @@ in the echo area or in a buffer. | |||
| 3927 | If the output is short enough to display in the echo area | 3935 | If the output is short enough to display in the echo area |
| 3928 | \(determined by the variable `max-mini-window-height' if | 3936 | \(determined by the variable `max-mini-window-height' if |
| 3929 | `resize-mini-windows' is non-nil), it is shown there. | 3937 | `resize-mini-windows' is non-nil), it is shown there. |
| 3930 | Otherwise it is displayed in the buffer `*Shell Command Output*'. | 3938 | Otherwise it is displayed in the buffer `shell-command-buffer-name'. |
| 3931 | The output is available in that buffer in both cases. | 3939 | The output is available in that buffer in both cases. |
| 3932 | 3940 | ||
| 3933 | If there is output and an error, a message about the error | 3941 | If there is output and an error, a message about the error |
| @@ -3937,7 +3945,7 @@ Optional fourth arg OUTPUT-BUFFER specifies where to put the | |||
| 3937 | command's output. If the value is a buffer or buffer name, | 3945 | command's output. If the value is a buffer or buffer name, |
| 3938 | erase that buffer and insert the output there; a non-nil value of | 3946 | erase that buffer and insert the output there; a non-nil value of |
| 3939 | `shell-command-dont-erase-buffer' prevent to erase the buffer. | 3947 | `shell-command-dont-erase-buffer' prevent to erase the buffer. |
| 3940 | If the value is nil, use the buffer `*Shell Command Output*'. | 3948 | If the value is nil, use the buffer `shell-command-buffer-name'. |
| 3941 | Any other non-nil value means to insert the output in the | 3949 | Any other non-nil value means to insert the output in the |
| 3942 | current buffer after START. | 3950 | current buffer after START. |
| 3943 | 3951 | ||
| @@ -4006,7 +4014,7 @@ characters." | |||
| 4006 | (funcall region-insert-function output)) | 4014 | (funcall region-insert-function output)) |
| 4007 | (t | 4015 | (t |
| 4008 | (let ((buffer (get-buffer-create | 4016 | (let ((buffer (get-buffer-create |
| 4009 | (or output-buffer "*Shell Command Output*")))) | 4017 | (or output-buffer shell-command-buffer-name)))) |
| 4010 | (with-current-buffer buffer | 4018 | (with-current-buffer buffer |
| 4011 | (erase-buffer) | 4019 | (erase-buffer) |
| 4012 | (funcall region-insert-function output)) | 4020 | (funcall region-insert-function output)) |
| @@ -4025,7 +4033,7 @@ characters." | |||
| 4025 | (list t error-file) | 4033 | (list t error-file) |
| 4026 | t))) | 4034 | t))) |
| 4027 | ;; It is rude to delete a buffer that the command is not using. | 4035 | ;; It is rude to delete a buffer that the command is not using. |
| 4028 | ;; (let ((shell-buffer (get-buffer "*Shell Command Output*"))) | 4036 | ;; (let ((shell-buffer (get-buffer shell-command-buffer-name))) |
| 4029 | ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) | 4037 | ;; (and shell-buffer (not (eq shell-buffer (current-buffer))) |
| 4030 | ;; (kill-buffer shell-buffer))) | 4038 | ;; (kill-buffer shell-buffer))) |
| 4031 | ;; Don't muck with mark unless REPLACE says we should. | 4039 | ;; Don't muck with mark unless REPLACE says we should. |
| @@ -4033,12 +4041,13 @@ characters." | |||
| 4033 | ;; No prefix argument: put the output in a temp buffer, | 4041 | ;; No prefix argument: put the output in a temp buffer, |
| 4034 | ;; replacing its entire contents. | 4042 | ;; replacing its entire contents. |
| 4035 | (let ((buffer (get-buffer-create | 4043 | (let ((buffer (get-buffer-create |
| 4036 | (or output-buffer "*Shell Command Output*")))) | 4044 | (or output-buffer shell-command-buffer-name)))) |
| 4037 | (set-buffer-major-mode buffer) ; Enable globalized modes (bug#38111) | 4045 | (set-buffer-major-mode buffer) ; Enable globalized modes (bug#38111) |
| 4038 | (unwind-protect | 4046 | (unwind-protect |
| 4039 | (if (and (eq buffer (current-buffer)) | 4047 | (if (and (eq buffer (current-buffer)) |
| 4040 | (or (memq shell-command-dont-erase-buffer '(nil erase)) | 4048 | (or (memq shell-command-dont-erase-buffer '(nil erase)) |
| 4041 | (and (not (eq buffer (get-buffer "*Shell Command Output*"))) | 4049 | (and (not (eq buffer (get-buffer |
| 4050 | shell-command-buffer-name))) | ||
| 4042 | (not (region-active-p))))) | 4051 | (not (region-active-p))))) |
| 4043 | ;; If the input is the same buffer as the output, | 4052 | ;; If the input is the same buffer as the output, |
| 4044 | ;; delete everything but the specified region, | 4053 | ;; delete everything but the specified region, |
diff --git a/lisp/skeleton.el b/lisp/skeleton.el index 8c694c128b5..ea4e5dbc227 100644 --- a/lisp/skeleton.el +++ b/lisp/skeleton.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; skeleton.el --- Lisp language extension for writing statement skeletons | 1 | ;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1993-1996, 2001-2020 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 1993-1996, 2001-2020 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -135,7 +135,8 @@ A prefix argument of -1 says to wrap around region, even if not highlighted. | |||
| 135 | A prefix argument of zero says to wrap around zero words---that is, nothing. | 135 | A prefix argument of zero says to wrap around zero words---that is, nothing. |
| 136 | This is a way of overriding the use of a highlighted region.") | 136 | This is a way of overriding the use of a highlighted region.") |
| 137 | (interactive "*P\nP") | 137 | (interactive "*P\nP") |
| 138 | (skeleton-proxy-new ',skeleton str arg)))) | 138 | (atomic-change-group |
| 139 | (skeleton-proxy-new ',skeleton str arg))))) | ||
| 139 | 140 | ||
| 140 | ;;;###autoload | 141 | ;;;###autoload |
| 141 | (defun skeleton-proxy-new (skeleton &optional str arg) | 142 | (defun skeleton-proxy-new (skeleton &optional str arg) |
| @@ -154,8 +155,7 @@ of `str' whereas the skeleton's interactor is then ignored." | |||
| 154 | (prefix-numeric-value (or arg | 155 | (prefix-numeric-value (or arg |
| 155 | current-prefix-arg)) | 156 | current-prefix-arg)) |
| 156 | (and skeleton-autowrap | 157 | (and skeleton-autowrap |
| 157 | (or (eq last-command 'mouse-drag-region) | 158 | (use-region-p) |
| 158 | (and transient-mark-mode mark-active)) | ||
| 159 | ;; Deactivate the mark, in case one of the | 159 | ;; Deactivate the mark, in case one of the |
| 160 | ;; elements of the skeleton is sensitive | 160 | ;; elements of the skeleton is sensitive |
| 161 | ;; to such situations (e.g. it is itself a | 161 | ;; to such situations (e.g. it is itself a |
| @@ -258,23 +258,25 @@ available: | |||
| 258 | (goto-char (car skeleton-regions)) | 258 | (goto-char (car skeleton-regions)) |
| 259 | (setq skeleton-regions (cdr skeleton-regions))) | 259 | (setq skeleton-regions (cdr skeleton-regions))) |
| 260 | (let ((beg (point)) | 260 | (let ((beg (point)) |
| 261 | skeleton-modified skeleton-point resume: help input v1 v2) | 261 | skeleton-modified skeleton-point) ;; resume: |
| 262 | (setq skeleton-positions nil) | 262 | (with-suppressed-warnings ((lexical help input v1 v2)) |
| 263 | (unwind-protect | 263 | (dlet (help input v1 v2) |
| 264 | (cl-progv | 264 | (setq skeleton-positions nil) |
| 265 | (mapcar #'car skeleton-further-elements) | 265 | (unwind-protect |
| 266 | (mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements) | 266 | (cl-progv |
| 267 | (skeleton-internal-list skeleton str)) | 267 | (mapcar #'car skeleton-further-elements) |
| 268 | (or (eolp) (not skeleton-end-newline) (newline-and-indent)) | 268 | (mapcar (lambda (x) (eval (cadr x) t)) skeleton-further-elements) |
| 269 | (run-hooks 'skeleton-end-hook) | 269 | (skeleton-internal-list skeleton str)) |
| 270 | (sit-for 0) | 270 | (or (eolp) (not skeleton-end-newline) (newline-and-indent)) |
| 271 | (or (not (eq (window-buffer) (current-buffer))) | 271 | (run-hooks 'skeleton-end-hook) |
| 272 | (pos-visible-in-window-p beg) | 272 | (sit-for 0) |
| 273 | (progn | 273 | (or (not (eq (window-buffer) (current-buffer))) |
| 274 | (goto-char beg) | 274 | (pos-visible-in-window-p beg) |
| 275 | (recenter 0))) | 275 | (progn |
| 276 | (if skeleton-point | 276 | (goto-char beg) |
| 277 | (goto-char skeleton-point)))))) | 277 | (recenter 0))) |
| 278 | (if skeleton-point | ||
| 279 | (goto-char skeleton-point)))))))) | ||
| 278 | 280 | ||
| 279 | (defun skeleton-read (prompt &optional initial-input recursive) | 281 | (defun skeleton-read (prompt &optional initial-input recursive) |
| 280 | "Function for reading a string from the minibuffer within skeletons. | 282 | "Function for reading a string from the minibuffer within skeletons. |
| @@ -327,36 +329,39 @@ automatically, and you are prompted to fill in the variable parts."))) | |||
| 327 | (signal 'quit t) | 329 | (signal 'quit t) |
| 328 | prompt)) | 330 | prompt)) |
| 329 | 331 | ||
| 330 | (defun skeleton-internal-list (skeleton-il &optional str recursive) | 332 | (defun skeleton-internal-list (skeleton &optional str recursive) |
| 331 | (let* ((start (line-beginning-position)) | 333 | (let* ((start (line-beginning-position)) |
| 332 | (column (current-column)) | 334 | (column (current-column)) |
| 333 | (line (buffer-substring start (line-end-position))) | 335 | (line (buffer-substring start (line-end-position))) |
| 334 | opoint) | 336 | (skeleton-il skeleton) |
| 335 | (or str | 337 | opoint) |
| 336 | (setq str `(setq str | 338 | (with-suppressed-warnings ((lexical str)) |
| 337 | (skeleton-read ',(car skeleton-il) nil ,recursive)))) | 339 | (dlet ((str (or str |
| 338 | (when (and (eq (cadr skeleton-il) '\n) (not recursive) | 340 | `(setq str |
| 339 | (save-excursion (skip-chars-backward " \t") (bolp))) | 341 | (skeleton-read ',(car skeleton-il) |
| 340 | (setq skeleton-il (cons nil (cons '> (cddr skeleton-il))))) | 342 | nil ,recursive))))) |
| 341 | (while (setq skeleton-modified (eq opoint (point)) | 343 | (when (and (eq (cadr skeleton-il) '\n) (not recursive) |
| 342 | opoint (point) | 344 | (save-excursion (skip-chars-backward " \t") (bolp))) |
| 343 | skeleton-il (cdr skeleton-il)) | 345 | (setq skeleton-il (cons nil (cons '> (cddr skeleton-il))))) |
| 344 | (condition-case quit | 346 | (while (setq skeleton-modified (eq opoint (point)) |
| 345 | (skeleton-internal-1 (car skeleton-il) nil recursive) | 347 | opoint (point) |
| 346 | (quit | 348 | skeleton-il (cdr skeleton-il)) |
| 347 | (if (eq (cdr quit) 'recursive) | 349 | (condition-case quit |
| 348 | (setq recursive 'quit | 350 | (skeleton-internal-1 (car skeleton-il) nil recursive) |
| 349 | skeleton-il (memq 'resume: skeleton-il)) | 351 | (quit |
| 350 | ;; Remove the subskeleton as far as it has been shown | 352 | (if (eq (cdr quit) 'recursive) |
| 351 | ;; the subskeleton shouldn't have deleted outside current line. | 353 | (setq recursive 'quit |
| 352 | (end-of-line) | 354 | skeleton-il (memq 'resume: skeleton-il)) |
| 353 | (delete-region start (point)) | 355 | ;; Remove the subskeleton as far as it has been shown |
| 354 | (insert line) | 356 | ;; the subskeleton shouldn't have deleted outside current line. |
| 355 | (move-to-column column) | 357 | (end-of-line) |
| 356 | (if (cdr quit) | 358 | (delete-region start (point)) |
| 357 | (setq skeleton-il () | 359 | (insert line) |
| 358 | recursive nil) | 360 | (move-to-column column) |
| 359 | (signal 'quit 'recursive))))))) | 361 | (if (cdr quit) |
| 362 | (setq skeleton-il () | ||
| 363 | recursive nil) | ||
| 364 | (signal 'quit 'recursive))))))))) | ||
| 360 | ;; maybe continue loop or go on to next outer resume: section | 365 | ;; maybe continue loop or go on to next outer resume: section |
| 361 | (if (eq recursive 'quit) | 366 | (if (eq recursive 'quit) |
| 362 | (signal 'quit 'recursive) | 367 | (signal 'quit 'recursive) |
diff --git a/lisp/so-long.el b/lisp/so-long.el index 6b05f4821b1..f2c078ba841 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el | |||
| @@ -38,7 +38,7 @@ | |||
| 38 | ;; compacted into the smallest file size possible, which often entails removing | 38 | ;; compacted into the smallest file size possible, which often entails removing |
| 39 | ;; newlines should they not be strictly necessary). This can result in lines | 39 | ;; newlines should they not be strictly necessary). This can result in lines |
| 40 | ;; which are many thousands of characters long, and most programming modes | 40 | ;; which are many thousands of characters long, and most programming modes |
| 41 | ;; simply aren't optimized (remotely) for this scenario, so performance can | 41 | ;; simply aren't optimised (remotely) for this scenario, so performance can |
| 42 | ;; suffer significantly. | 42 | ;; suffer significantly. |
| 43 | ;; | 43 | ;; |
| 44 | ;; When such files are detected, the command `so-long' is automatically called, | 44 | ;; When such files are detected, the command `so-long' is automatically called, |
| @@ -69,7 +69,7 @@ | |||
| 69 | ;; the long lines. In such circumstances you may find that `longlines-mode' is | 69 | ;; the long lines. In such circumstances you may find that `longlines-mode' is |
| 70 | ;; the most helpful facility. | 70 | ;; the most helpful facility. |
| 71 | ;; | 71 | ;; |
| 72 | ;; Note also that the mitigation is automatically triggered when visiting a | 72 | ;; Note also that the mitigations are automatically triggered when visiting a |
| 73 | ;; file. The library does not automatically detect if long lines are inserted | 73 | ;; file. The library does not automatically detect if long lines are inserted |
| 74 | ;; into an existing buffer (although the `so-long' command can be invoked | 74 | ;; into an existing buffer (although the `so-long' command can be invoked |
| 75 | ;; manually in such situations). | 75 | ;; manually in such situations). |
| @@ -90,7 +90,7 @@ | |||
| 90 | ;; * Overview of modes and commands | 90 | ;; * Overview of modes and commands |
| 91 | ;; -------------------------------- | 91 | ;; -------------------------------- |
| 92 | ;; - `global-so-long-mode' - A global minor mode which enables the automated | 92 | ;; - `global-so-long-mode' - A global minor mode which enables the automated |
| 93 | ;; behavior, causing the user's preferred action to be invoked whenever a | 93 | ;; behaviour, causing the user's preferred action to be invoked whenever a |
| 94 | ;; newly-visited file contains excessively long lines. | 94 | ;; newly-visited file contains excessively long lines. |
| 95 | ;; - `so-long-mode' - A major mode, and the default action. | 95 | ;; - `so-long-mode' - A major mode, and the default action. |
| 96 | ;; - `so-long-minor-mode' - A minor mode version of the major mode, and an | 96 | ;; - `so-long-minor-mode' - A minor mode version of the major mode, and an |
| @@ -111,7 +111,7 @@ | |||
| 111 | ;; | 111 | ;; |
| 112 | ;; On rare occasions you may choose to manually invoke the `so-long' command, | 112 | ;; On rare occasions you may choose to manually invoke the `so-long' command, |
| 113 | ;; which invokes your preferred `so-long-action' (exactly as the automatic | 113 | ;; which invokes your preferred `so-long-action' (exactly as the automatic |
| 114 | ;; behavior would do if it had detected long lines). You might use this if a | 114 | ;; behaviour would do if it had detected long lines). You might use this if a |
| 115 | ;; problematic file did not meet your configured criteria, and you wished to | 115 | ;; problematic file did not meet your configured criteria, and you wished to |
| 116 | ;; trigger the performance improvements manually. | 116 | ;; trigger the performance improvements manually. |
| 117 | ;; | 117 | ;; |
| @@ -120,7 +120,7 @@ | |||
| 120 | ;; available to `so-long' but, like any other mode, they can be invoked directly | 120 | ;; available to `so-long' but, like any other mode, they can be invoked directly |
| 121 | ;; if you have a need to do that (see also "Other ways of using so-long" below). | 121 | ;; if you have a need to do that (see also "Other ways of using so-long" below). |
| 122 | ;; | 122 | ;; |
| 123 | ;; If the behavior ever triggers when you did not want it to, you can use the | 123 | ;; If the behaviour ever triggers when you did not want it to, you can use the |
| 124 | ;; `so-long-revert' command to restore the buffer to its original state. | 124 | ;; `so-long-revert' command to restore the buffer to its original state. |
| 125 | 125 | ||
| 126 | ;; * Basic configuration | 126 | ;; * Basic configuration |
| @@ -199,7 +199,7 @@ | |||
| 199 | ;; | 199 | ;; |
| 200 | ;; Note that `so-long-minor-modes' is not useful for other global minor modes | 200 | ;; Note that `so-long-minor-modes' is not useful for other global minor modes |
| 201 | ;; (as distinguished from globalized minor modes), but in some cases it will be | 201 | ;; (as distinguished from globalized minor modes), but in some cases it will be |
| 202 | ;; possible to inhibit or otherwise counter-act the behavior of a global mode | 202 | ;; possible to inhibit or otherwise counter-act the behaviour of a global mode |
| 203 | ;; by overriding variables, or by employing hooks (see below). You would need | 203 | ;; by overriding variables, or by employing hooks (see below). You would need |
| 204 | ;; to inspect the code for a given global mode (on a case by case basis) to | 204 | ;; to inspect the code for a given global mode (on a case by case basis) to |
| 205 | ;; determine whether it's possible to inhibit it for a single buffer -- and if | 205 | ;; determine whether it's possible to inhibit it for a single buffer -- and if |
| @@ -211,7 +211,7 @@ | |||
| 211 | ;; If `so-long-action' is set to either `so-long-mode' or `so-long-minor-mode', | 211 | ;; If `so-long-action' is set to either `so-long-mode' or `so-long-minor-mode', |
| 212 | ;; the buffer-local value for each variable in the list is set to the associated | 212 | ;; the buffer-local value for each variable in the list is set to the associated |
| 213 | ;; value in the alist. Use this to enforce values which will improve | 213 | ;; value in the alist. Use this to enforce values which will improve |
| 214 | ;; performance or otherwise avoid undesirable behaviors. If `so-long-revert' | 214 | ;; performance or otherwise avoid undesirable behaviours. If `so-long-revert' |
| 215 | ;; is called, then the original values are restored. | 215 | ;; is called, then the original values are restored. |
| 216 | 216 | ||
| 217 | ;; * Hooks | 217 | ;; * Hooks |
| @@ -325,7 +325,7 @@ | |||
| 325 | ;; meaning you would need to add to `safe-local-variable-values' in order to | 325 | ;; meaning you would need to add to `safe-local-variable-values' in order to |
| 326 | ;; avoid being queried about them. | 326 | ;; avoid being queried about them. |
| 327 | ;; | 327 | ;; |
| 328 | ;; Finally, the `so-long-predicate' user option enables the automated behavior | 328 | ;; Finally, the `so-long-predicate' user option enables the automated behaviour |
| 329 | ;; to be determined by a custom function, if greater control is needed. | 329 | ;; to be determined by a custom function, if greater control is needed. |
| 330 | 330 | ||
| 331 | ;; * Implementation notes | 331 | ;; * Implementation notes |
| @@ -342,7 +342,7 @@ | |||
| 342 | 342 | ||
| 343 | ;; * Caveats | 343 | ;; * Caveats |
| 344 | ;; --------- | 344 | ;; --------- |
| 345 | ;; The variables affecting the automated behavior of this library (such as | 345 | ;; The variables affecting the automated behaviour of this library (such as |
| 346 | ;; `so-long-action') can be used as file- or dir-local values in Emacs 26+, but | 346 | ;; `so-long-action') can be used as file- or dir-local values in Emacs 26+, but |
| 347 | ;; not in previous versions of Emacs. This is on account of improvements made | 347 | ;; not in previous versions of Emacs. This is on account of improvements made |
| 348 | ;; to `normal-mode' in 26.1, which altered the execution order with respect to | 348 | ;; to `normal-mode' in 26.1, which altered the execution order with respect to |
| @@ -386,7 +386,7 @@ | |||
| 386 | ;; - Added sgml-mode and nxml-mode to `so-long-target-modes'. | 386 | ;; - Added sgml-mode and nxml-mode to `so-long-target-modes'. |
| 387 | ;; 0.7.4 - Refactored the handling of `whitespace-mode'. | 387 | ;; 0.7.4 - Refactored the handling of `whitespace-mode'. |
| 388 | ;; 0.7.3 - Added customize group `so-long' with user options. | 388 | ;; 0.7.3 - Added customize group `so-long' with user options. |
| 389 | ;; - Added `so-long-original-values' to generalize the storage and | 389 | ;; - Added `so-long-original-values' to generalise the storage and |
| 390 | ;; restoration of values from the original mode upon `so-long-revert'. | 390 | ;; restoration of values from the original mode upon `so-long-revert'. |
| 391 | ;; - Added `so-long-revert-hook'. | 391 | ;; - Added `so-long-revert-hook'. |
| 392 | ;; 0.7.2 - Remember the original major mode even with M-x `so-long-mode'. | 392 | ;; 0.7.2 - Remember the original major mode even with M-x `so-long-mode'. |
| @@ -399,7 +399,7 @@ | |||
| 399 | ;; 0.6 - Added `so-long-minor-modes' and `so-long-hook'. | 399 | ;; 0.6 - Added `so-long-minor-modes' and `so-long-hook'. |
| 400 | ;; 0.5 - Renamed library to "so-long.el". | 400 | ;; 0.5 - Renamed library to "so-long.el". |
| 401 | ;; - Added explicit `so-long-enable' command to activate our advice. | 401 | ;; - Added explicit `so-long-enable' command to activate our advice. |
| 402 | ;; 0.4 - Amended/documented behavior with file-local 'mode' variables. | 402 | ;; 0.4 - Amended/documented behaviour with file-local 'mode' variables. |
| 403 | ;; 0.3 - Defer to a file-local 'mode' variable. | 403 | ;; 0.3 - Defer to a file-local 'mode' variable. |
| 404 | ;; 0.2 - Initial release to EmacsWiki. | 404 | ;; 0.2 - Initial release to EmacsWiki. |
| 405 | ;; 0.1 - Experimental. | 405 | ;; 0.1 - Experimental. |
| @@ -421,7 +421,7 @@ | |||
| 421 | Has no effect if `global-so-long-mode' is not enabled.") | 421 | Has no effect if `global-so-long-mode' is not enabled.") |
| 422 | 422 | ||
| 423 | (defvar-local so-long--active nil ; internal use | 423 | (defvar-local so-long--active nil ; internal use |
| 424 | "Non-nil when `so-long' mitigation is in effect.") | 424 | "Non-nil when `so-long' mitigations are in effect.") |
| 425 | 425 | ||
| 426 | (defvar so-long--set-auto-mode nil ; internal use | 426 | (defvar so-long--set-auto-mode nil ; internal use |
| 427 | "Non-nil while `set-auto-mode' is executing.") | 427 | "Non-nil while `set-auto-mode' is executing.") |
| @@ -500,7 +500,7 @@ files would prevent Emacs from handling them correctly." | |||
| 500 | (defcustom so-long-invisible-buffer-function #'so-long-deferred | 500 | (defcustom so-long-invisible-buffer-function #'so-long-deferred |
| 501 | "Function called in place of `so-long' when the buffer is not displayed. | 501 | "Function called in place of `so-long' when the buffer is not displayed. |
| 502 | 502 | ||
| 503 | This affects the behavior of `global-so-long-mode'. | 503 | This affects the behaviour of `global-so-long-mode'. |
| 504 | 504 | ||
| 505 | We treat invisible buffers differently from displayed buffers because, in | 505 | We treat invisible buffers differently from displayed buffers because, in |
| 506 | cases where a library is using a buffer for behind-the-scenes processing, | 506 | cases where a library is using a buffer for behind-the-scenes processing, |
| @@ -548,7 +548,7 @@ Defaults to `so-long-detected-long-line-p'." | |||
| 548 | (defun so-long--action-type () | 548 | (defun so-long--action-type () |
| 549 | "Generate a :type for `so-long-action' based on `so-long-action-alist'." | 549 | "Generate a :type for `so-long-action' based on `so-long-action-alist'." |
| 550 | ;; :type seemingly cannot be a form to be evaluated on demand, so we | 550 | ;; :type seemingly cannot be a form to be evaluated on demand, so we |
| 551 | ;; endeavor to keep it up-to-date with `so-long-action-alist' by | 551 | ;; endeavour to keep it up-to-date with `so-long-action-alist' by |
| 552 | ;; calling this from `so-long--action-alist-setter'. | 552 | ;; calling this from `so-long--action-alist-setter'. |
| 553 | `(radio ,@(mapcar (lambda (x) (list 'const :tag (cadr x) (car x))) | 553 | `(radio ,@(mapcar (lambda (x) (list 'const :tag (cadr x) (car x))) |
| 554 | (assq-delete-all nil so-long-action-alist)) | 554 | (assq-delete-all nil so-long-action-alist)) |
| @@ -609,7 +609,7 @@ will be automatically processed; but custom actions can also do these things. | |||
| 609 | The value `longlines-mode' causes that minor mode to be enabled. See | 609 | The value `longlines-mode' causes that minor mode to be enabled. See |
| 610 | longlines.el for more details. | 610 | longlines.el for more details. |
| 611 | 611 | ||
| 612 | Each action likewise determines the behavior of `so-long-revert'. | 612 | Each action likewise determines the behaviour of `so-long-revert'. |
| 613 | 613 | ||
| 614 | If the value is nil, or not defined in `so-long-action-alist', then no action | 614 | If the value is nil, or not defined in `so-long-action-alist', then no action |
| 615 | will be taken." | 615 | will be taken." |
| @@ -740,7 +740,7 @@ was established." | |||
| 740 | ) | 740 | ) |
| 741 | ;; It's not clear to me whether all of these would be problematic, but they | 741 | ;; It's not clear to me whether all of these would be problematic, but they |
| 742 | ;; seemed like reasonable targets. Some are certainly excessive in smaller | 742 | ;; seemed like reasonable targets. Some are certainly excessive in smaller |
| 743 | ;; buffers of minified code, but we should be aiming to maximize performance | 743 | ;; buffers of minified code, but we should be aiming to maximise performance |
| 744 | ;; by default, so that Emacs is as responsive as we can manage in even very | 744 | ;; by default, so that Emacs is as responsive as we can manage in even very |
| 745 | ;; large buffers of minified code. | 745 | ;; large buffers of minified code. |
| 746 | "List of buffer-local minor modes to explicitly disable. | 746 | "List of buffer-local minor modes to explicitly disable. |
| @@ -756,7 +756,7 @@ By default this happens if `so-long-action' is set to either `so-long-mode' | |||
| 756 | or `so-long-minor-mode'. If `so-long-revert' is subsequently invoked, then the | 756 | or `so-long-minor-mode'. If `so-long-revert' is subsequently invoked, then the |
| 757 | disabled modes are re-enabled by calling them with the numeric argument 1. | 757 | disabled modes are re-enabled by calling them with the numeric argument 1. |
| 758 | 758 | ||
| 759 | `so-long-hook' can be used where more custom behavior is desired. | 759 | `so-long-hook' can be used where more custom behaviour is desired. |
| 760 | 760 | ||
| 761 | Please submit bug reports to recommend additional modes for this list, whether | 761 | Please submit bug reports to recommend additional modes for this list, whether |
| 762 | they are in Emacs core, GNU ELPA, or elsewhere." | 762 | they are in Emacs core, GNU ELPA, or elsewhere." |
| @@ -781,9 +781,20 @@ If `so-long-revert' is subsequently invoked, then the variables are restored | |||
| 781 | to their original states. | 781 | to their original states. |
| 782 | 782 | ||
| 783 | The combination of `line-move-visual' (enabled) and `truncate-lines' (disabled) | 783 | The combination of `line-move-visual' (enabled) and `truncate-lines' (disabled) |
| 784 | is important for maximizing responsiveness when moving vertically within an | 784 | is important for maximising responsiveness when moving vertically within an |
| 785 | extremely long line, as otherwise the full length of the line may need to be | 785 | extremely long line, as otherwise the full length of the line may need to be |
| 786 | scanned to find the next position." | 786 | scanned to find the next position. |
| 787 | |||
| 788 | Bidirectional text display -- especially handling the large quantities of | ||
| 789 | nested parentheses which are liable to occur in minified programming code -- | ||
| 790 | can be very expensive for extremely long lines, and so this support is disabled | ||
| 791 | by default (insofar as is supported; in particular `bidi-inhibit-bpa' is not | ||
| 792 | available in Emacs versions < 27). For more information refer to info node | ||
| 793 | `(emacs) Bidirectional Editing' and info node `(elisp) Bidirectional Display'. | ||
| 794 | |||
| 795 | Buffers are made read-only by default to prevent potentially-slow editing from | ||
| 796 | occurring inadvertantly, as buffers with excessively long lines are likely not | ||
| 797 | intended to be edited manually." | ||
| 787 | :type '(alist :key-type (variable :tag "Variable") | 798 | :type '(alist :key-type (variable :tag "Variable") |
| 788 | :value-type (sexp :tag "Value")) | 799 | :value-type (sexp :tag "Value")) |
| 789 | :options '((bidi-inhibit-bpa boolean) | 800 | :options '((bidi-inhibit-bpa boolean) |
| @@ -822,18 +833,18 @@ If nil, no mode line indicator will be displayed." | |||
| 822 | 833 | ||
| 823 | (defface so-long-mode-line-active | 834 | (defface so-long-mode-line-active |
| 824 | '((t :inherit mode-line-emphasis)) | 835 | '((t :inherit mode-line-emphasis)) |
| 825 | "Face for `so-long-mode-line-info' when mitigation is active." | 836 | "Face for `so-long-mode-line-info' when mitigations are active." |
| 826 | :package-version '(so-long . "1.0")) | 837 | :package-version '(so-long . "1.0")) |
| 827 | 838 | ||
| 828 | (defface so-long-mode-line-inactive | 839 | (defface so-long-mode-line-inactive |
| 829 | '((t :inherit mode-line-inactive)) | 840 | '((t :inherit mode-line-inactive)) |
| 830 | "Face for `so-long-mode-line-info' when mitigation has been reverted." | 841 | "Face for `so-long-mode-line-info' when mitigations have been reverted." |
| 831 | :package-version '(so-long . "1.0")) | 842 | :package-version '(so-long . "1.0")) |
| 832 | 843 | ||
| 833 | ;; Modes that go slowly and line lengths excessive | 844 | ;; Modes that go slowly and line lengths excessive |
| 834 | ;; Font-lock performance becoming oppressive | 845 | ;; Font-lock performance becoming oppressive |
| 835 | ;; All of my CPU tied up with strings | 846 | ;; All of my CPU tied up with strings |
| 836 | ;; These are a few of my least-favorite things | 847 | ;; These are a few of my least-favourite things |
| 837 | 848 | ||
| 838 | (defvar-local so-long-original-values nil | 849 | (defvar-local so-long-original-values nil |
| 839 | "Alist holding the buffer's original `major-mode' value, and other data. | 850 | "Alist holding the buffer's original `major-mode' value, and other data. |
| @@ -985,7 +996,7 @@ Displayed as part of `mode-line-misc-info'. | |||
| 985 | 996 | ||
| 986 | `so-long-mode-line-label' defines the text to be displayed (if any). | 997 | `so-long-mode-line-label' defines the text to be displayed (if any). |
| 987 | 998 | ||
| 988 | Face `so-long-mode-line-active' is used while mitigation is active, and | 999 | Face `so-long-mode-line-active' is used while mitigations are active, and |
| 989 | `so-long-mode-line-inactive' is used if `so-long-revert' is called. | 1000 | `so-long-mode-line-inactive' is used if `so-long-revert' is called. |
| 990 | 1001 | ||
| 991 | Not displayed when `so-long-mode' is enabled, as the major mode construct | 1002 | Not displayed when `so-long-mode' is enabled, as the major mode construct |
| @@ -1038,7 +1049,9 @@ This is the default value of `so-long-predicate'." | |||
| 1038 | (let ((count 0) start) | 1049 | (let ((count 0) start) |
| 1039 | (save-excursion | 1050 | (save-excursion |
| 1040 | (goto-char (point-min)) | 1051 | (goto-char (point-min)) |
| 1041 | (when so-long-skip-leading-comments | 1052 | (when (and so-long-skip-leading-comments |
| 1053 | (or comment-use-syntax ;; Refer to `comment-forward'. | ||
| 1054 | (and comment-start-skip comment-end-skip))) | ||
| 1042 | ;; Skip the shebang line, if any. This is not necessarily comment | 1055 | ;; Skip the shebang line, if any. This is not necessarily comment |
| 1043 | ;; syntax, so we need to treat it specially. | 1056 | ;; syntax, so we need to treat it specially. |
| 1044 | (when (looking-at "#!") | 1057 | (when (looking-at "#!") |
| @@ -1131,7 +1144,7 @@ This minor mode is a standard `so-long-action' option." | |||
| 1131 | (if so-long-minor-mode ;; We are enabling the mode. | 1144 | (if so-long-minor-mode ;; We are enabling the mode. |
| 1132 | (progn | 1145 | (progn |
| 1133 | ;; Housekeeping. `so-long-minor-mode' might be invoked directly rather | 1146 | ;; Housekeeping. `so-long-minor-mode' might be invoked directly rather |
| 1134 | ;; than via `so-long', so replicate the necessary behaviors. The minor | 1147 | ;; than via `so-long', so replicate the necessary behaviours. The minor |
| 1135 | ;; mode also cares about whether `so-long' was already active, as we do | 1148 | ;; mode also cares about whether `so-long' was already active, as we do |
| 1136 | ;; not want to remember values which were potentially overridden already. | 1149 | ;; not want to remember values which were potentially overridden already. |
| 1137 | (unless (or so-long--calling so-long--active) | 1150 | (unless (or so-long--calling so-long--active) |
| @@ -1203,9 +1216,9 @@ values), despite potential performance issues, type \\[so-long-revert]. | |||
| 1203 | 1216 | ||
| 1204 | Use \\[so-long-commentary] for more information. | 1217 | Use \\[so-long-commentary] for more information. |
| 1205 | 1218 | ||
| 1206 | Use \\[so-long-customize] to configure the behavior." | 1219 | Use \\[so-long-customize] to configure the behaviour." |
| 1207 | ;; Housekeeping. `so-long-mode' might be invoked directly rather than via | 1220 | ;; Housekeeping. `so-long-mode' might be invoked directly rather than via |
| 1208 | ;; `so-long', so replicate the necessary behaviors. We could use this same | 1221 | ;; `so-long', so replicate the necessary behaviours. We could use this same |
| 1209 | ;; test in `so-long-after-change-major-mode' to run `so-long-hook', but that's | 1222 | ;; test in `so-long-after-change-major-mode' to run `so-long-hook', but that's |
| 1210 | ;; not so obviously the right thing to do, so I've omitted it for now. | 1223 | ;; not so obviously the right thing to do, so I've omitted it for now. |
| 1211 | (unless so-long--calling | 1224 | (unless so-long--calling |
| @@ -1251,7 +1264,7 @@ Use \\[so-long-customize] to configure the behavior." | |||
| 1251 | This advice acts before `so-long-mode', with the previous mode still active." | 1264 | This advice acts before `so-long-mode', with the previous mode still active." |
| 1252 | (unless (derived-mode-p 'so-long-mode) | 1265 | (unless (derived-mode-p 'so-long-mode) |
| 1253 | ;; Housekeeping. `so-long-mode' might be invoked directly rather than | 1266 | ;; Housekeeping. `so-long-mode' might be invoked directly rather than |
| 1254 | ;; via `so-long', so replicate the necessary behaviors. | 1267 | ;; via `so-long', so replicate the necessary behaviours. |
| 1255 | (unless so-long--calling | 1268 | (unless so-long--calling |
| 1256 | (so-long-remember-all :reset)) | 1269 | (so-long-remember-all :reset)) |
| 1257 | ;; Remember the original major mode, regardless. | 1270 | ;; Remember the original major mode, regardless. |
| @@ -1336,7 +1349,7 @@ This is the `so-long-revert-function' for `so-long-mode'." | |||
| 1336 | ;; Emacs 26+ has already called `hack-local-variables' (during | 1349 | ;; Emacs 26+ has already called `hack-local-variables' (during |
| 1337 | ;; `run-mode-hooks'; provided there was a `buffer-file-name'), but for older | 1350 | ;; `run-mode-hooks'; provided there was a `buffer-file-name'), but for older |
| 1338 | ;; versions we need to call it here. In Emacs 26+ the revised 'HANDLE-MODE' | 1351 | ;; versions we need to call it here. In Emacs 26+ the revised 'HANDLE-MODE' |
| 1339 | ;; argument is set to `no-mode' (being the non-nil-and-non-t behavior), | 1352 | ;; argument is set to `no-mode' (being the non-nil-and-non-t behaviour), |
| 1340 | ;; which we mimic here by binding `so-long--hack-local-variables-no-mode', | 1353 | ;; which we mimic here by binding `so-long--hack-local-variables-no-mode', |
| 1341 | ;; in order to prevent a local 'mode' variable from clobbering the major | 1354 | ;; in order to prevent a local 'mode' variable from clobbering the major |
| 1342 | ;; mode we have just called. | 1355 | ;; mode we have just called. |
| @@ -1373,7 +1386,7 @@ because we do not want to downgrade the major mode in that scenario." | |||
| 1373 | ;; Act only if `so-long-mode' would be enabled by the current action. | 1386 | ;; Act only if `so-long-mode' would be enabled by the current action. |
| 1374 | (when (and (symbolp (so-long-function)) | 1387 | (when (and (symbolp (so-long-function)) |
| 1375 | (provided-mode-derived-p (so-long-function) 'so-long-mode)) | 1388 | (provided-mode-derived-p (so-long-function) 'so-long-mode)) |
| 1376 | ;; Downgrade from `so-long-mode' to the `so-long-minor-mode' behavior. | 1389 | ;; Downgrade from `so-long-mode' to the `so-long-minor-mode' behaviour. |
| 1377 | (setq so-long-function 'turn-on-so-long-minor-mode | 1390 | (setq so-long-function 'turn-on-so-long-minor-mode |
| 1378 | so-long-revert-function 'turn-off-so-long-minor-mode)))) | 1391 | so-long-revert-function 'turn-off-so-long-minor-mode)))) |
| 1379 | 1392 | ||
| @@ -1393,7 +1406,7 @@ and cannot be conveniently intercepted, so we are forced to replicate it here. | |||
| 1393 | 1406 | ||
| 1394 | This special-case code will ultimately be removed from Emacs, as it exists to | 1407 | This special-case code will ultimately be removed from Emacs, as it exists to |
| 1395 | deal with a deprecated feature; but until then we need to replicate it in order | 1408 | deal with a deprecated feature; but until then we need to replicate it in order |
| 1396 | to inhibit our own behavior in the presence of a header comment `mode' | 1409 | to inhibit our own behaviour in the presence of a header comment `mode' |
| 1397 | declaration. | 1410 | declaration. |
| 1398 | 1411 | ||
| 1399 | If a file-local mode is detected in the header comment, then we call the | 1412 | If a file-local mode is detected in the header comment, then we call the |
| @@ -1528,7 +1541,7 @@ by testing the value against `major-mode'; but as we may have changed the | |||
| 1528 | major mode to `so-long-mode' by this point, that protection is insufficient | 1541 | major mode to `so-long-mode' by this point, that protection is insufficient |
| 1529 | and so we need to perform our own test. | 1542 | and so we need to perform our own test. |
| 1530 | 1543 | ||
| 1531 | We likewise need to support an equivalent of the `no-mode' behavior in 26.1+ | 1544 | We likewise need to support an equivalent of the `no-mode' behaviour in 26.1+ |
| 1532 | to ensure that `so-long-mode-revert' will not restore a file-local mode again | 1545 | to ensure that `so-long-mode-revert' will not restore a file-local mode again |
| 1533 | after it has already reverted to the original mode. | 1546 | after it has already reverted to the original mode. |
| 1534 | 1547 | ||
| @@ -1661,7 +1674,7 @@ Equivalent to calling (global-so-long-mode 0)" | |||
| 1661 | 1674 | ||
| 1662 | ;;;###autoload | 1675 | ;;;###autoload |
| 1663 | (define-minor-mode global-so-long-mode | 1676 | (define-minor-mode global-so-long-mode |
| 1664 | "Toggle automated performance mitigation for files with long lines. | 1677 | "Toggle automated performance mitigations for files with long lines. |
| 1665 | 1678 | ||
| 1666 | Many Emacs modes struggle with buffers which contain excessively long lines, | 1679 | Many Emacs modes struggle with buffers which contain excessively long lines, |
| 1667 | and may consequently cause unacceptable performance issues. | 1680 | and may consequently cause unacceptable performance issues. |
| @@ -1675,7 +1688,7 @@ When such files are detected by `so-long-predicate', we invoke the selected | |||
| 1675 | 1688 | ||
| 1676 | Use \\[so-long-commentary] for more information. | 1689 | Use \\[so-long-commentary] for more information. |
| 1677 | 1690 | ||
| 1678 | Use \\[so-long-customize] to configure the behavior." | 1691 | Use \\[so-long-customize] to configure the behaviour." |
| 1679 | :global t | 1692 | :global t |
| 1680 | :group 'so-long | 1693 | :group 'so-long |
| 1681 | (if global-so-long-mode | 1694 | (if global-so-long-mode |
| @@ -1810,9 +1823,10 @@ If it appears in `%s', you should remove it." | |||
| 1810 | ;; Update to version 1.0 from earlier versions: | 1823 | ;; Update to version 1.0 from earlier versions: |
| 1811 | (when (version< so-long-version "1.0") | 1824 | (when (version< so-long-version "1.0") |
| 1812 | (remove-hook 'change-major-mode-hook 'so-long-change-major-mode) | 1825 | (remove-hook 'change-major-mode-hook 'so-long-change-major-mode) |
| 1813 | (require 'advice) | 1826 | (eval-and-compile (require 'advice)) ;; Both macros and functions. |
| 1814 | (declare-function ad-find-advice "advice") | 1827 | (declare-function ad-find-advice "advice") |
| 1815 | (declare-function ad-remove-advice "advice") | 1828 | (declare-function ad-remove-advice "advice") |
| 1829 | (declare-function ad-activate "advice") | ||
| 1816 | (when (ad-find-advice 'hack-local-variables 'after 'so-long--file-local-mode) | 1830 | (when (ad-find-advice 'hack-local-variables 'after 'so-long--file-local-mode) |
| 1817 | (ad-remove-advice 'hack-local-variables 'after 'so-long--file-local-mode) | 1831 | (ad-remove-advice 'hack-local-variables 'after 'so-long--file-local-mode) |
| 1818 | (ad-activate 'hack-local-variables)) | 1832 | (ad-activate 'hack-local-variables)) |
| @@ -1864,8 +1878,8 @@ If it appears in `%s', you should remove it." | |||
| 1864 | ; LocalWords: noerror selectable mapc sgml nxml hl flydiff defs arg Phil Sainty | 1878 | ; LocalWords: noerror selectable mapc sgml nxml hl flydiff defs arg Phil Sainty |
| 1865 | ; LocalWords: defadvice nadvice whitespace ie bos eos eobp origmode un Un setq | 1879 | ; LocalWords: defadvice nadvice whitespace ie bos eos eobp origmode un Un setq |
| 1866 | ; LocalWords: docstring auf Wiedersehen longlines alist autoload Refactored Inc | 1880 | ; LocalWords: docstring auf Wiedersehen longlines alist autoload Refactored Inc |
| 1867 | ; LocalWords: MERCHANTABILITY RET REGEXP VAR ELPA WS EmacsWiki eval | 1881 | ; LocalWords: MERCHANTABILITY RET REGEXP VAR ELPA WS mitigations EmacsWiki eval |
| 1868 | ; LocalWords: rx filename filenames | 1882 | ; LocalWords: rx filename filenames bidi bpa |
| 1869 | 1883 | ||
| 1870 | ;; So long, farewell, auf Wiedersehen, goodbye | 1884 | ;; So long, farewell, auf Wiedersehen, goodbye |
| 1871 | ;; You have to go, this code is minified | 1885 | ;; You have to go, this code is minified |
diff --git a/lisp/subr.el b/lisp/subr.el index 2ef28b1ce6a..0ae636b68b4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el | |||
| @@ -888,6 +888,10 @@ side-effects, and the argument LIST is not modified." | |||
| 888 | 888 | ||
| 889 | ;;;; Keymap support. | 889 | ;;;; Keymap support. |
| 890 | 890 | ||
| 891 | ;; Declare before first use of `save-match-data', | ||
| 892 | ;; where it is used internally. | ||
| 893 | (defvar save-match-data-internal) | ||
| 894 | |||
| 891 | (defun kbd (keys) | 895 | (defun kbd (keys) |
| 892 | "Convert KEYS to the internal Emacs key representation. | 896 | "Convert KEYS to the internal Emacs key representation. |
| 893 | KEYS should be a string in the format returned by commands such | 897 | KEYS should be a string in the format returned by commands such |
| @@ -4110,8 +4114,6 @@ MODES is as for `set-default-file-modes'." | |||
| 4110 | 4114 | ||
| 4111 | ;;; Matching and match data. | 4115 | ;;; Matching and match data. |
| 4112 | 4116 | ||
| 4113 | (defvar save-match-data-internal) | ||
| 4114 | |||
| 4115 | ;; We use save-match-data-internal as the local variable because | 4117 | ;; We use save-match-data-internal as the local variable because |
| 4116 | ;; that works ok in practice (people should not use that variable elsewhere). | 4118 | ;; that works ok in practice (people should not use that variable elsewhere). |
| 4117 | ;; We used to use an uninterned symbol; the compiler handles that properly | 4119 | ;; We used to use an uninterned symbol; the compiler handles that properly |
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index 73978ffc4a7..5cf09f9055e 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el | |||
| @@ -922,6 +922,56 @@ actually appear on disk when you save the tar-file's buffer." | |||
| 922 | (setq buffer-undo-list nil)))) | 922 | (setq buffer-undo-list nil)))) |
| 923 | buffer)) | 923 | buffer)) |
| 924 | 924 | ||
| 925 | (defun tar-goto-file (file) | ||
| 926 | "Go to FILE in the current buffer. | ||
| 927 | FILE should be a relative file name. If FILE can't be found, | ||
| 928 | return nil. Otherwise point is returned." | ||
| 929 | (let ((start (point)) | ||
| 930 | found) | ||
| 931 | (goto-char (point-min)) | ||
| 932 | (while (and (not found) | ||
| 933 | (not (eobp))) | ||
| 934 | (forward-line 1) | ||
| 935 | (when-let ((descriptor (ignore-errors (tar-get-descriptor)))) | ||
| 936 | (when (equal (tar-header-name descriptor) file) | ||
| 937 | (setq found t)))) | ||
| 938 | (if (not found) | ||
| 939 | (progn | ||
| 940 | (goto-char start) | ||
| 941 | nil) | ||
| 942 | (point)))) | ||
| 943 | |||
| 944 | (defun tar-next-file-displayer (file regexp n) | ||
| 945 | "Return a closure to display the next file after FILE that matches REGEXP." | ||
| 946 | (let ((short (replace-regexp-in-string "\\`.*!" "" file)) | ||
| 947 | next) | ||
| 948 | ;; The tar buffer chops off leading "./", so do the same | ||
| 949 | ;; here. | ||
| 950 | (setq short (replace-regexp-in-string "\\`\\./" "" file)) | ||
| 951 | (tar-goto-file short) | ||
| 952 | (while (and (not next) | ||
| 953 | ;; Stop if we reach the end/start of the buffer. | ||
| 954 | (if (> n 0) | ||
| 955 | (not (eobp)) | ||
| 956 | (not (save-excursion | ||
| 957 | (beginning-of-line) | ||
| 958 | (bobp))))) | ||
| 959 | (tar-next-line n) | ||
| 960 | (when-let ((descriptor (ignore-errors (tar-get-descriptor)))) | ||
| 961 | (let ((candidate (tar-header-name descriptor)) | ||
| 962 | (buffer (current-buffer))) | ||
| 963 | (when (and candidate | ||
| 964 | (string-match-p regexp candidate)) | ||
| 965 | (setq next (lambda () | ||
| 966 | (kill-buffer (current-buffer)) | ||
| 967 | (switch-to-buffer buffer) | ||
| 968 | (tar-extract))))))) | ||
| 969 | (unless next | ||
| 970 | ;; If we didn't find a next/prev file, then restore | ||
| 971 | ;; point. | ||
| 972 | (tar-goto-file short)) | ||
| 973 | next)) | ||
| 974 | |||
| 925 | (defun tar-extract (&optional other-window-p) | 975 | (defun tar-extract (&optional other-window-p) |
| 926 | "In Tar mode, extract this entry of the tar file into its own buffer." | 976 | "In Tar mode, extract this entry of the tar file into its own buffer." |
| 927 | (interactive) | 977 | (interactive) |
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index 2cd99787e8a..cc5879880c8 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el | |||
| @@ -67,7 +67,7 @@ | |||
| 67 | 67 | ||
| 68 | (defconst scss-at-ids | 68 | (defconst scss-at-ids |
| 69 | '("at-root" "content" "debug" "each" "else" "else if" "error" "extend" | 69 | '("at-root" "content" "debug" "each" "else" "else if" "error" "extend" |
| 70 | "for" "function" "if" "import" "include" "mixin" "return" "warn" | 70 | "for" "function" "if" "import" "include" "mixin" "return" "use" "warn" |
| 71 | "while") | 71 | "while") |
| 72 | "Additional identifiers that appear in the form @foo in SCSS.") | 72 | "Additional identifiers that appear in the form @foo in SCSS.") |
| 73 | 73 | ||
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index b5ff6a69671..1672dce4f23 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el | |||
| @@ -1806,6 +1806,7 @@ This takes effect when first loading the library.") | |||
| 1806 | (define-key map "\C-c\C-cc" 'html-checkboxes) | 1806 | (define-key map "\C-c\C-cc" 'html-checkboxes) |
| 1807 | (define-key map "\C-c\C-cl" 'html-list-item) | 1807 | (define-key map "\C-c\C-cl" 'html-list-item) |
| 1808 | (define-key map "\C-c\C-ch" 'html-href-anchor) | 1808 | (define-key map "\C-c\C-ch" 'html-href-anchor) |
| 1809 | (define-key map "\C-c\C-cf" 'html-href-anchor-file) | ||
| 1809 | (define-key map "\C-c\C-cn" 'html-name-anchor) | 1810 | (define-key map "\C-c\C-cn" 'html-name-anchor) |
| 1810 | (define-key map "\C-c\C-c#" 'html-id-anchor) | 1811 | (define-key map "\C-c\C-c#" 'html-id-anchor) |
| 1811 | (define-key map "\C-c\C-ci" 'html-image) | 1812 | (define-key map "\C-c\C-ci" 'html-image) |
| @@ -1818,6 +1819,7 @@ This takes effect when first loading the library.") | |||
| 1818 | (define-key map "\C-cc" 'html-checkboxes) | 1819 | (define-key map "\C-cc" 'html-checkboxes) |
| 1819 | (define-key map "\C-cl" 'html-list-item) | 1820 | (define-key map "\C-cl" 'html-list-item) |
| 1820 | (define-key map "\C-ch" 'html-href-anchor) | 1821 | (define-key map "\C-ch" 'html-href-anchor) |
| 1822 | (define-key map "\C-cf" 'html-href-anchor-file) | ||
| 1821 | (define-key map "\C-cn" 'html-name-anchor) | 1823 | (define-key map "\C-cn" 'html-name-anchor) |
| 1822 | (define-key map "\C-c#" 'html-id-anchor) | 1824 | (define-key map "\C-c#" 'html-id-anchor) |
| 1823 | (define-key map "\C-ci" 'html-image) | 1825 | (define-key map "\C-ci" 'html-image) |
| @@ -1845,7 +1847,8 @@ This takes effect when first loading the library.") | |||
| 1845 | (define-key menu-map "\n" '("Line Break" . html-line)) | 1847 | (define-key menu-map "\n" '("Line Break" . html-line)) |
| 1846 | (define-key menu-map "\r" '("Paragraph" . html-paragraph)) | 1848 | (define-key menu-map "\r" '("Paragraph" . html-paragraph)) |
| 1847 | (define-key menu-map "i" '("Image" . html-image)) | 1849 | (define-key menu-map "i" '("Image" . html-image)) |
| 1848 | (define-key menu-map "h" '("Href Anchor" . html-href-anchor)) | 1850 | (define-key menu-map "h" '("Href Anchor URL" . html-href-anchor)) |
| 1851 | (define-key menu-map "f" '("Href Anchor File" . html-href-anchor-file)) | ||
| 1849 | (define-key menu-map "n" '("Name Anchor" . html-name-anchor)) | 1852 | (define-key menu-map "n" '("Name Anchor" . html-name-anchor)) |
| 1850 | (define-key menu-map "#" '("ID Anchor" . html-id-anchor)) | 1853 | (define-key menu-map "#" '("ID Anchor" . html-id-anchor)) |
| 1851 | map) | 1854 | map) |
| @@ -2453,6 +2456,11 @@ HTML Autoview mode is a buffer-local minor mode for use with | |||
| 2453 | ;; '(setq input "http:") | 2456 | ;; '(setq input "http:") |
| 2454 | "<a href=\"" str "\">" _ "</a>") | 2457 | "<a href=\"" str "\">" _ "</a>") |
| 2455 | 2458 | ||
| 2459 | (define-skeleton html-href-anchor-file | ||
| 2460 | "HTML anchor tag with href attribute (from a local file)." | ||
| 2461 | (file-relative-name (read-file-name "File name: ") default-directory) | ||
| 2462 | "<a href=\"" str "\">" _ "</a>") | ||
| 2463 | |||
| 2456 | (define-skeleton html-name-anchor | 2464 | (define-skeleton html-name-anchor |
| 2457 | "HTML anchor tag with name attribute." | 2465 | "HTML anchor tag with name attribute." |
| 2458 | "Name: " | 2466 | "Name: " |
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 1a15df33e50..483a2c9bd83 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el | |||
| @@ -334,7 +334,7 @@ the bounds of a possible ill-formed URI (one lacking a scheme)." | |||
| 334 | ;; may contain parentheses but may not contain spaces (RFC3986). | 334 | ;; may contain parentheses but may not contain spaces (RFC3986). |
| 335 | (let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'") | 335 | (let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'") |
| 336 | (skip-before "^[0-9a-zA-Z]") | 336 | (skip-before "^[0-9a-zA-Z]") |
| 337 | (skip-after ":;.,!?") | 337 | (skip-after ":;.,!?'") |
| 338 | (pt (point)) | 338 | (pt (point)) |
| 339 | (beg (save-excursion | 339 | (beg (save-excursion |
| 340 | (skip-chars-backward allowed-chars) | 340 | (skip-chars-backward allowed-chars) |
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 95ced7b8d09..cb0657e70a0 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el | |||
| @@ -186,6 +186,16 @@ highlighting the Log View buffer." | |||
| 186 | :group 'vc-hg | 186 | :group 'vc-hg |
| 187 | :version "24.5") | 187 | :version "24.5") |
| 188 | 188 | ||
| 189 | (defcustom vc-hg-create-bookmark t | ||
| 190 | "This controls whether `vc-create-tag' will create a bookmark or branch. | ||
| 191 | If nil, named branch will be created. | ||
| 192 | If t, bookmark will be created. | ||
| 193 | If `ask', you will be prompted for a branch type." | ||
| 194 | :type '(choice (const :tag "No" nil) | ||
| 195 | (const :tag "Yes" t) | ||
| 196 | (const :tag "Ask" ask)) | ||
| 197 | :version "28.1") | ||
| 198 | |||
| 189 | 199 | ||
| 190 | ;; Clear up the cache to force vc-call to check again and discover | 200 | ;; Clear up the cache to force vc-call to check again and discover |
| 191 | ;; new functions when we reload this file. | 201 | ;; new functions when we reload this file. |
| @@ -625,10 +635,18 @@ Optional arg REVISION is a revision to annotate from." | |||
| 625 | ;;; Tag system | 635 | ;;; Tag system |
| 626 | 636 | ||
| 627 | (defun vc-hg-create-tag (dir name branchp) | 637 | (defun vc-hg-create-tag (dir name branchp) |
| 628 | "Attach the tag NAME to the state of the working copy." | 638 | "Create tag NAME in repo in DIR. Create branch if BRANCHP. |
| 639 | Variable `vc-hg-create-bookmark' controls what kind of branch will be created." | ||
| 629 | (let ((default-directory dir)) | 640 | (let ((default-directory dir)) |
| 630 | (and (vc-hg-command nil 0 nil "status") | 641 | (vc-hg-command nil 0 nil |
| 631 | (vc-hg-command nil 0 nil (if branchp "bookmark" "tag") name)))) | 642 | (if branchp |
| 643 | (if (if (eq vc-hg-create-bookmark 'ask) | ||
| 644 | (yes-or-no-p "Create bookmark instead of branch? ") | ||
| 645 | vc-hg-create-bookmark) | ||
| 646 | "bookmark" | ||
| 647 | "branch") | ||
| 648 | "tag") | ||
| 649 | name))) | ||
| 632 | 650 | ||
| 633 | (defun vc-hg-retrieve-tag (dir name _update) | 651 | (defun vc-hg-retrieve-tag (dir name _update) |
| 634 | "Retrieve the version tagged by NAME of all registered files at or below DIR." | 652 | "Retrieve the version tagged by NAME of all registered files at or below DIR." |
| @@ -1366,25 +1384,28 @@ REV is the revision to check out into WORKFILE." | |||
| 1366 | (vc-run-delayed | 1384 | (vc-run-delayed |
| 1367 | (vc-hg-after-dir-status update-function))) | 1385 | (vc-hg-after-dir-status update-function))) |
| 1368 | 1386 | ||
| 1369 | (defun vc-hg-dir-extra-header (name &rest commands) | ||
| 1370 | (concat (propertize name 'face 'font-lock-type-face) | ||
| 1371 | (propertize | ||
| 1372 | (with-temp-buffer | ||
| 1373 | (apply 'vc-hg-command (current-buffer) 0 nil commands) | ||
| 1374 | (buffer-substring-no-properties (point-min) (1- (point-max)))) | ||
| 1375 | 'face 'font-lock-variable-name-face))) | ||
| 1376 | |||
| 1377 | (defun vc-hg-dir-extra-headers (dir) | 1387 | (defun vc-hg-dir-extra-headers (dir) |
| 1378 | "Generate extra status headers for a Mercurial tree." | 1388 | "Generate extra status headers for a repository in DIR. |
| 1389 | This runs the command \"hg summary\"." | ||
| 1379 | (let ((default-directory dir)) | 1390 | (let ((default-directory dir)) |
| 1380 | (concat | 1391 | (with-temp-buffer |
| 1381 | (vc-hg-dir-extra-header "Root : " "root") "\n" | 1392 | (vc-hg-command t 0 nil "summary") |
| 1382 | (vc-hg-dir-extra-header "Branch : " "id" "-b") "\n" | 1393 | (goto-char (point-min)) |
| 1383 | (vc-hg-dir-extra-header "Tags : " "id" "-t") ; "\n" | 1394 | (mapconcat |
| 1384 | ;; these change after each commit | 1395 | #'identity |
| 1385 | ;; (vc-hg-dir-extra-header "Local num : " "id" "-n") "\n" | 1396 | (let (result) |
| 1386 | ;; (vc-hg-dir-extra-header "Global id : " "id" "-i") | 1397 | (while (not (eobp)) |
| 1387 | ))) | 1398 | (push |
| 1399 | (let ((entry (if (looking-at "\\([^ ].*\\): \\(.*\\)") | ||
| 1400 | (cons (capitalize (match-string 1)) (match-string 2)) | ||
| 1401 | (cons "" (buffer-substring (point) (line-end-position)))))) | ||
| 1402 | (concat | ||
| 1403 | (propertize (format "%-11s: " (car entry)) 'face 'font-lock-type-face) | ||
| 1404 | (propertize (cdr entry) 'face 'font-lock-variable-name-face))) | ||
| 1405 | result) | ||
| 1406 | (forward-line)) | ||
| 1407 | (nreverse result)) | ||
| 1408 | "\n")))) | ||
| 1388 | 1409 | ||
| 1389 | (defun vc-hg-log-incoming (buffer remote-location) | 1410 | (defun vc-hg-log-incoming (buffer remote-location) |
| 1390 | (vc-setup-buffer buffer) | 1411 | (vc-setup-buffer buffer) |
diff --git a/lisp/wdired.el b/lisp/wdired.el index 768b8f597b4..b98becfafe7 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el | |||
| @@ -609,7 +609,10 @@ Optional arguments are ignored." | |||
| 609 | (defun wdired--restore-dired-filename-prop (beg end _len) | 609 | (defun wdired--restore-dired-filename-prop (beg end _len) |
| 610 | (save-match-data | 610 | (save-match-data |
| 611 | (save-excursion | 611 | (save-excursion |
| 612 | (let ((lep (line-end-position))) | 612 | (let ((lep (line-end-position)) |
| 613 | (used-F (dired-check-switches | ||
| 614 | dired-actual-switches | ||
| 615 | "F" "classify"))) | ||
| 613 | (beginning-of-line) | 616 | (beginning-of-line) |
| 614 | (when (re-search-forward | 617 | (when (re-search-forward |
| 615 | directory-listing-before-filename-regexp lep t) | 618 | directory-listing-before-filename-regexp lep t) |
| @@ -623,13 +626,17 @@ Optional arguments are ignored." | |||
| 623 | (and (re-search-backward | 626 | (and (re-search-backward |
| 624 | dired-permission-flags-regexp nil t) | 627 | dired-permission-flags-regexp nil t) |
| 625 | (looking-at "l") | 628 | (looking-at "l") |
| 626 | (search-forward " -> " lep t)) | 629 | ;; macOS and Ultrix adds "@" to the end |
| 630 | ;; of symlinks when using -F. | ||
| 631 | (if (and used-F | ||
| 632 | dired-ls-F-marks-symlinks) | ||
| 633 | (re-search-forward "@? -> " lep t) | ||
| 634 | (search-forward " -> " lep t))) | ||
| 627 | ;; When dired-listing-switches includes "F" | 635 | ;; When dired-listing-switches includes "F" |
| 628 | ;; or "classify", don't treat appended | 636 | ;; or "classify", don't treat appended |
| 629 | ;; indicator characters as part of the file | 637 | ;; indicator characters as part of the file |
| 630 | ;; name (bug#34915). | 638 | ;; name (bug#34915). |
| 631 | (and (dired-check-switches dired-actual-switches | 639 | (and used-F |
| 632 | "F" "classify") | ||
| 633 | (re-search-forward "[*/@|=>]$" lep t))) | 640 | (re-search-forward "[*/@|=>]$" lep t))) |
| 634 | (goto-char (match-beginning 0)) | 641 | (goto-char (match-beginning 0)) |
| 635 | lep)) | 642 | lep)) |
diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 47434bf3d2e..42c4b61daff 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el | |||
| @@ -283,7 +283,8 @@ | |||
| 283 | '(face | 283 | '(face |
| 284 | tabs spaces trailing lines space-before-tab newline | 284 | tabs spaces trailing lines space-before-tab newline |
| 285 | indentation empty space-after-tab | 285 | indentation empty space-after-tab |
| 286 | space-mark tab-mark newline-mark) | 286 | space-mark tab-mark newline-mark |
| 287 | missing-newline-at-eof) | ||
| 287 | "Specify which kind of blank is visualized. | 288 | "Specify which kind of blank is visualized. |
| 288 | 289 | ||
| 289 | It's a list containing some or all of the following values: | 290 | It's a list containing some or all of the following values: |
| @@ -326,6 +327,11 @@ It's a list containing some or all of the following values: | |||
| 326 | It has effect only if `face' (see above) | 327 | It has effect only if `face' (see above) |
| 327 | is present in `whitespace-style'. | 328 | is present in `whitespace-style'. |
| 328 | 329 | ||
| 330 | missing-newline-at-eof Missing newline at the end of the file is | ||
| 331 | visualized via faces. | ||
| 332 | It has effect only if `face' (see above) | ||
| 333 | is present in `whitespace-style'. | ||
| 334 | |||
| 329 | empty empty lines at beginning and/or end of buffer | 335 | empty empty lines at beginning and/or end of buffer |
| 330 | are visualized via faces. | 336 | are visualized via faces. |
| 331 | It has effect only if `face' (see above) | 337 | It has effect only if `face' (see above) |
| @@ -586,6 +592,10 @@ line. Used when `whitespace-style' includes the value `indentation'.") | |||
| 586 | "Face used to visualize big indentation." | 592 | "Face used to visualize big indentation." |
| 587 | :group 'whitespace) | 593 | :group 'whitespace) |
| 588 | 594 | ||
| 595 | (defface whitespace-missing-newline-at-eof | ||
| 596 | '((((class mono)) :inverse-video t :weight bold :underline t) | ||
| 597 | (t :background "#d0d040" :foreground "black")) | ||
| 598 | "Face used to visualize missing newline at the end of the file.") | ||
| 589 | 599 | ||
| 590 | (defvar whitespace-empty 'whitespace-empty | 600 | (defvar whitespace-empty 'whitespace-empty |
| 591 | "Symbol face used to visualize empty lines at beginning and/or end of buffer. | 601 | "Symbol face used to visualize empty lines at beginning and/or end of buffer. |
| @@ -1700,6 +1710,8 @@ cleaning up these problems." | |||
| 1700 | (whitespace-space-after-tab-regexp 'tab)) | 1710 | (whitespace-space-after-tab-regexp 'tab)) |
| 1701 | ((eq (car option) 'space-after-tab::space) | 1711 | ((eq (car option) 'space-after-tab::space) |
| 1702 | (whitespace-space-after-tab-regexp 'space)) | 1712 | (whitespace-space-after-tab-regexp 'space)) |
| 1713 | ((eq (car option) 'missing-newline-at-eof) | ||
| 1714 | "[^\n]\\'") | ||
| 1703 | (t | 1715 | (t |
| 1704 | (cdr option))))) | 1716 | (cdr option))))) |
| 1705 | (when (re-search-forward regexp rend t) | 1717 | (when (re-search-forward regexp rend t) |
| @@ -2122,7 +2134,16 @@ resultant list will be returned." | |||
| 2122 | ((memq 'space-after-tab::space whitespace-active-style) | 2134 | ((memq 'space-after-tab::space whitespace-active-style) |
| 2123 | ;; Show SPACEs after TAB (TABs). | 2135 | ;; Show SPACEs after TAB (TABs). |
| 2124 | (whitespace-space-after-tab-regexp 'space))) | 2136 | (whitespace-space-after-tab-regexp 'space))) |
| 2125 | 1 whitespace-space-after-tab t))))) | 2137 | 1 whitespace-space-after-tab t))) |
| 2138 | ,@(when (memq 'missing-newline-at-eof whitespace-active-style) | ||
| 2139 | ;; Show missing newline. | ||
| 2140 | `(("[^\n]\\'" 0 | ||
| 2141 | ;; Don't mark the end of the buffer is point is there -- | ||
| 2142 | ;; it probably means that the user is typing something | ||
| 2143 | ;; at the end of the buffer. | ||
| 2144 | (and (/= whitespace-point (point-max)) | ||
| 2145 | 'whitespace-missing-newline-at-eof) | ||
| 2146 | t))))) | ||
| 2126 | (font-lock-add-keywords nil whitespace-font-lock-keywords t) | 2147 | (font-lock-add-keywords nil whitespace-font-lock-keywords t) |
| 2127 | (font-lock-flush))) | 2148 | (font-lock-flush))) |
| 2128 | 2149 | ||
diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 284fd1d6cbd..ea7e266e0d0 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el | |||
| @@ -577,6 +577,63 @@ respectively." | |||
| 577 | (if (and widget (funcall function widget maparg)) | 577 | (if (and widget (funcall function widget maparg)) |
| 578 | (setq overlays nil))))) | 578 | (setq overlays nil))))) |
| 579 | 579 | ||
| 580 | (defun widget-describe (&optional widget-or-pos) | ||
| 581 | "Describe the widget at point. | ||
| 582 | Displays a buffer with information about the widget (e.g., its actions) as well | ||
| 583 | as a link to browse all the properties of the widget. | ||
| 584 | |||
| 585 | This command resolves the indirection of widgets running the action of its | ||
| 586 | parents, so the real action executed can be known. | ||
| 587 | |||
| 588 | When called from Lisp, pass WIDGET-OR-POS as the widget to describe, | ||
| 589 | or a buffer position where a widget is present. If WIDGET-OR-POS is nil, | ||
| 590 | the widget at point is the widget to describe." | ||
| 591 | (interactive "d") | ||
| 592 | (require 'wid-browse) ; The widget-browse widget. | ||
| 593 | (let ((widget (if (widgetp widget-or-pos) | ||
| 594 | widget-or-pos | ||
| 595 | (widget-at widget-or-pos))) | ||
| 596 | props) | ||
| 597 | (when widget | ||
| 598 | (help-setup-xref (list #'widget-describe widget) | ||
| 599 | (called-interactively-p 'interactive)) | ||
| 600 | (setq props (list (cons 'action (widget--resolve-parent-action widget)) | ||
| 601 | (cons 'mouse-down-action | ||
| 602 | (widget-get widget :mouse-down-action)))) | ||
| 603 | (with-help-window (help-buffer) | ||
| 604 | (with-current-buffer (help-buffer) | ||
| 605 | (widget-insert "This widget's type is ") | ||
| 606 | (widget-create 'widget-browse :format "%[%v%]\n%d" | ||
| 607 | :doc (get (car widget) 'widget-documentation) | ||
| 608 | :help-echo "Browse this widget's properties" | ||
| 609 | widget) | ||
| 610 | (dolist (action '(action mouse-down-action)) | ||
| 611 | (let ((name (symbol-name action)) | ||
| 612 | (val (alist-get action props))) | ||
| 613 | (when (functionp val) | ||
| 614 | (widget-insert "\n\n" (propertize (capitalize name) 'face 'bold) | ||
| 615 | "'\nThe " name " of this widget is") | ||
| 616 | (if (symbolp val) | ||
| 617 | (progn (widget-insert " ") | ||
| 618 | (widget-create 'function-link :value val | ||
| 619 | :button-prefix "" :button-suffix "" | ||
| 620 | :help-echo "Describe this function")) | ||
| 621 | (widget-insert "\n") | ||
| 622 | (princ val))))))) | ||
| 623 | (widget-setup) | ||
| 624 | t))) | ||
| 625 | |||
| 626 | (defun widget--resolve-parent-action (widget) | ||
| 627 | "Resolve the real action of WIDGET up its inheritance chain. | ||
| 628 | Follow the WIDGET's parents, until its :action is no longer | ||
| 629 | `widget-parent-action', and return its value." | ||
| 630 | (let ((action (widget-get widget :action)) | ||
| 631 | (parent (widget-get widget :parent))) | ||
| 632 | (while (eq action 'widget-parent-action) | ||
| 633 | (setq parent (widget-get parent :parent) | ||
| 634 | action (widget-get parent :action))) | ||
| 635 | action)) | ||
| 636 | |||
| 580 | ;;; Images. | 637 | ;;; Images. |
| 581 | 638 | ||
| 582 | (defcustom widget-image-directory (file-name-as-directory | 639 | (defcustom widget-image-directory (file-name-as-directory |
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index b22af5cc770..1d49f462531 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; x-dnd.el --- drag and drop support for X | 1 | ;;; x-dnd.el --- drag and drop support for X -*- lexical-binding: t; -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 2004-2020 Free Software Foundation, Inc. | 3 | ;; Copyright (C) 2004-2020 Free Software Foundation, Inc. |
| 4 | 4 | ||
| @@ -32,7 +32,7 @@ | |||
| 32 | (require 'dnd) | 32 | (require 'dnd) |
| 33 | 33 | ||
| 34 | ;;; Customizable variables | 34 | ;;; Customizable variables |
| 35 | (defcustom x-dnd-test-function 'x-dnd-default-test-function | 35 | (defcustom x-dnd-test-function #'x-dnd-default-test-function |
| 36 | "The function drag and drop uses to determine if to accept or reject a drop. | 36 | "The function drag and drop uses to determine if to accept or reject a drop. |
| 37 | The function takes three arguments, WINDOW, ACTION and TYPES. | 37 | The function takes three arguments, WINDOW, ACTION and TYPES. |
| 38 | WINDOW is where the mouse is when the function is called. WINDOW may be a | 38 | WINDOW is where the mouse is when the function is called. WINDOW may be a |
diff --git a/m4/alloca.m4 b/m4/alloca.m4 index d3e98c51bf4..b777f8450ce 100644 --- a/m4/alloca.m4 +++ b/m4/alloca.m4 | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | # alloca.m4 serial 16 | 1 | # alloca.m4 serial 17 |
| 2 | dnl Copyright (C) 2002-2004, 2006-2007, 2009-2020 Free Software Foundation, | 2 | dnl Copyright (C) 2002-2004, 2006-2007, 2009-2020 Free Software Foundation, |
| 3 | dnl Inc. | 3 | dnl Inc. |
| 4 | dnl This file is free software; the Free Software Foundation | 4 | dnl This file is free software; the Free Software Foundation |
| @@ -50,10 +50,13 @@ AC_DEFUN([gl_FUNC_ALLOCA], | |||
| 50 | # STACK_DIRECTION is already handled by AC_FUNC_ALLOCA. | 50 | # STACK_DIRECTION is already handled by AC_FUNC_ALLOCA. |
| 51 | AC_DEFUN([gl_PREREQ_ALLOCA], [:]) | 51 | AC_DEFUN([gl_PREREQ_ALLOCA], [:]) |
| 52 | 52 | ||
| 53 | # This works around a bug in autoconf <= 2.68. | 53 | m4_version_prereq([2.70], [], [ |
| 54 | # See <https://lists.gnu.org/r/bug-gnulib/2011-06/msg00277.html> and | 54 | |
| 55 | # <https://git.savannah.gnu.org/gitweb/?p=autoconf.git;a=commitdiff;h=6cd9f12520b0d6f76d3230d7565feba1ecf29497>. | 55 | # This works around a bug in autoconf <= 2.68 and has simplifications |
| 56 | # Also it has a simplification that is not yet in Autoconf. | 56 | # from 2.70. See: |
| 57 | # https://lists.gnu.org/r/bug-gnulib/2011-06/msg00277.html | ||
| 58 | # https://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=6cd9f12520b0d6f76d3230d7565feba1ecf29497 | ||
| 59 | # https://git.savannah.gnu.org/cgit/autoconf.git/commit/?id=15edf7fd8094fd14a89d9891dd72a9624762597a | ||
| 57 | 60 | ||
| 58 | # _AC_LIBOBJ_ALLOCA | 61 | # _AC_LIBOBJ_ALLOCA |
| 59 | # ----------------- | 62 | # ----------------- |
| @@ -102,3 +105,4 @@ AH_VERBATIM([STACK_DIRECTION], | |||
| 102 | @%:@undef STACK_DIRECTION])dnl | 105 | @%:@undef STACK_DIRECTION])dnl |
| 103 | AC_DEFINE_UNQUOTED(STACK_DIRECTION, $ac_cv_c_stack_direction) | 106 | AC_DEFINE_UNQUOTED(STACK_DIRECTION, $ac_cv_c_stack_direction) |
| 104 | ]) | 107 | ]) |
| 108 | ]) | ||
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index 57f3a780118..50acc0a474b 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | # gnulib-common.m4 serial 52 | 1 | # gnulib-common.m4 serial 53 |
| 2 | dnl Copyright (C) 2007-2020 Free Software Foundation, Inc. | 2 | dnl Copyright (C) 2007-2020 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, |
| @@ -300,7 +300,9 @@ AC_DEFUN([gl_COMMON_BODY], [ | |||
| 300 | #define _GL_ASYNC_SAFE | 300 | #define _GL_ASYNC_SAFE |
| 301 | ]) | 301 | ]) |
| 302 | AH_VERBATIM([micro_optimizations], | 302 | AH_VERBATIM([micro_optimizations], |
| 303 | [/* _GL_CMP (n1, n2) performs a three-valued comparison on n1 vs. n2. | 303 | [/* _GL_CMP (n1, n2) performs a three-valued comparison on n1 vs. n2, where |
| 304 | n1 and n2 are expressions without side effects, that evaluate to real | ||
| 305 | numbers (excluding NaN). | ||
| 304 | It returns | 306 | It returns |
| 305 | 1 if n1 > n2 | 307 | 1 if n1 > n2 |
| 306 | 0 if n1 == n2 | 308 | 0 if n1 == n2 |
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4 index 4472af81b70..5bfa1473edd 100644 --- a/m4/gnulib-comp.m4 +++ b/m4/gnulib-comp.m4 | |||
| @@ -346,7 +346,7 @@ AC_DEFUN([gl_INIT], | |||
| 346 | AC_REQUIRE([gl_LARGEFILE]) | 346 | AC_REQUIRE([gl_LARGEFILE]) |
| 347 | gl___INLINE | 347 | gl___INLINE |
| 348 | gl_LIBGMP | 348 | gl_LIBGMP |
| 349 | if test -n "$GMP_H"; then | 349 | if test $HAVE_LIBGMP != yes; then |
| 350 | AC_LIBOBJ([mini-gmp-gnulib]) | 350 | AC_LIBOBJ([mini-gmp-gnulib]) |
| 351 | fi | 351 | fi |
| 352 | gl_LIMITS_H | 352 | gl_LIMITS_H |
diff --git a/m4/largefile.m4 b/m4/largefile.m4 index 8017ca70eb4..f7140dd0a3a 100644 --- a/m4/largefile.m4 +++ b/m4/largefile.m4 | |||
| @@ -35,7 +35,7 @@ m4_define([_AC_SYS_LARGEFILE_TEST_INCLUDES], | |||
| 35 | We can't simply define LARGE_OFF_T to be 9223372036854775807, | 35 | We can't simply define LARGE_OFF_T to be 9223372036854775807, |
| 36 | since some C++ compilers masquerading as C compilers | 36 | since some C++ compilers masquerading as C compilers |
| 37 | incorrectly reject 9223372036854775807. */ | 37 | incorrectly reject 9223372036854775807. */ |
| 38 | @%:@define LARGE_OFF_T (((off_t) 1 << 62) - 1 + ((off_t) 1 << 62)) | 38 | @%:@define LARGE_OFF_T (((off_t) 1 << 31 << 31) - 1 + ((off_t) 1 << 31 << 31)) |
| 39 | int off_t_is_large[[(LARGE_OFF_T % 2147483629 == 721 | 39 | int off_t_is_large[[(LARGE_OFF_T % 2147483629 == 721 |
| 40 | && LARGE_OFF_T % 2147483647 == 1) | 40 | && LARGE_OFF_T % 2147483647 == 1) |
| 41 | ? 1 : -1]];[]dnl | 41 | ? 1 : -1]];[]dnl |
diff --git a/m4/libgmp.m4 b/m4/libgmp.m4 index 82c065e2c2c..1025f06a775 100644 --- a/m4/libgmp.m4 +++ b/m4/libgmp.m4 | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | # libgmp.m4 serial 4 | 1 | # libgmp.m4 serial 5 |
| 2 | # Configure the GMP library or a replacement. | 2 | # Configure the GMP library or a replacement. |
| 3 | dnl Copyright 2020 Free Software Foundation, Inc. | 3 | dnl Copyright 2020 Free Software Foundation, Inc. |
| 4 | dnl This file is free software; the Free Software Foundation | 4 | dnl This file is free software; the Free Software Foundation |
| @@ -18,50 +18,54 @@ AC_DEFUN([gl_LIBGMP], | |||
| 18 | [AS_HELP_STRING([--without-libgmp], | 18 | [AS_HELP_STRING([--without-libgmp], |
| 19 | [do not use the GNU Multiple Precision (GMP) library; | 19 | [do not use the GNU Multiple Precision (GMP) library; |
| 20 | this is the default on systems lacking libgmp.])]) | 20 | this is the default on systems lacking libgmp.])]) |
| 21 | case "$with_libgmp" in | 21 | HAVE_LIBGMP=no |
| 22 | no) | 22 | LIBGMP= |
| 23 | HAVE_LIBGMP=no | 23 | LTLIBGMP= |
| 24 | LIBGMP= | 24 | AS_IF([test "$with_libgmp" != no], |
| 25 | LTLIBGMP= | 25 | [AC_CHECK_HEADERS([gmp.h gmp/gmp.h], [break]) |
| 26 | ;; | 26 | dnl Prefer AC_LIB_HAVE_LINKFLAGS if the havelib module is also in use. |
| 27 | *) | 27 | AS_IF([test "$ac_cv_header_gmp_h" = yes || |
| 28 | dnl Prefer AC_LIB_HAVE_LINKFLAGS if the havelib module is also in use. | 28 | test "$ac_cv_header_gmp_gmp_h" = yes], |
| 29 | m4_ifdef([gl_HAVE_MODULE_HAVELIB], | 29 | [m4_ifdef([gl_HAVE_MODULE_HAVELIB], |
| 30 | [AC_LIB_HAVE_LINKFLAGS([gmp], [], | 30 | [AC_LIB_HAVE_LINKFLAGS([gmp], [], |
| 31 | [#include <gmp.h>], | 31 | [#if HAVE_GMP_H |
| 32 | [static const mp_limb_t x[2] = { 0x73, 0x55 }; | 32 | # include <gmp.h> |
| 33 | mpz_t tmp; | 33 | #else |
| 34 | mpz_roinit_n (tmp, x, 2); | 34 | # include <gmp/gmp.h> |
| 35 | ], | 35 | #endif], |
| 36 | [no])], | 36 | [static const mp_limb_t x[2] = { 0x73, 0x55 }; |
| 37 | [gl_saved_LIBS=$LIBS | 37 | mpz_t tmp; |
| 38 | AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp]) | 38 | mpz_roinit_n (tmp, x, 2); |
| 39 | LIBS=$gl_saved_LIBS | 39 | ], |
| 40 | case $ac_cv_search___gmpz_roinit_n in | 40 | [no])], |
| 41 | 'none needed') | 41 | [gl_saved_LIBS=$LIBS |
| 42 | HAVE_LIBGMP=yes LIBGMP=;; | 42 | AC_SEARCH_LIBS([__gmpz_roinit_n], [gmp]) |
| 43 | -*) | 43 | LIBS=$gl_saved_LIBS |
| 44 | HAVE_LIBGMP=yes LIBGMP=$ac_cv_search___gmpz_roinit_n;; | 44 | case $ac_cv_search___gmpz_roinit_n in |
| 45 | *) | 45 | 'none needed') |
| 46 | HAVE_LIBGMP=no LIBGMP=;; | 46 | HAVE_LIBGMP=yes;; |
| 47 | esac | 47 | -*) |
| 48 | LTLIBGMP=$LIBGMP | 48 | HAVE_LIBGMP=yes |
| 49 | AC_SUBST([HAVE_LIBGMP]) | 49 | LIBGMP=$ac_cv_search___gmpz_roinit_n |
| 50 | AC_SUBST([LIBGMP]) | 50 | LTLIBGMP=$LIBGMP;; |
| 51 | AC_SUBST([LTLIBGMP])]) | 51 | esac |
| 52 | if test "$with_libgmp,$HAVE_LIBGMP" = yes,no; then | 52 | AC_SUBST([HAVE_LIBGMP]) |
| 53 | AC_MSG_ERROR( | 53 | AC_SUBST([LIBGMP]) |
| 54 | [GMP not found, although --with-libgmp was specified.m4_ifdef( | 54 | AC_SUBST([LTLIBGMP])])]) |
| 55 | [AC_LIB_HAVE_LINKFLAGS], | 55 | if test "$with_libgmp,$HAVE_LIBGMP" = yes,no; then |
| 56 | [ Try specifying --with-libgmp-prefix=DIR.])]) | 56 | AC_MSG_ERROR( |
| 57 | fi | 57 | [GMP not found, although --with-libgmp was specified.m4_ifdef( |
| 58 | ;; | 58 | [AC_LIB_HAVE_LINKFLAGS], |
| 59 | esac | 59 | [ Try specifying --with-libgmp-prefix=DIR.])]) |
| 60 | if test $HAVE_LIBGMP = yes; then | 60 | fi]) |
| 61 | if test $HAVE_LIBGMP = yes && test "$ac_cv_header_gmp_h" = yes; then | ||
| 61 | GMP_H= | 62 | GMP_H= |
| 62 | else | 63 | else |
| 63 | GMP_H=gmp.h | 64 | GMP_H=gmp.h |
| 64 | fi | 65 | fi |
| 65 | AC_SUBST([GMP_H]) | 66 | AC_SUBST([GMP_H]) |
| 66 | AM_CONDITIONAL([GL_GENERATE_GMP_H], [test -n "$GMP_H"]) | 67 | AM_CONDITIONAL([GL_GENERATE_MINI_GMP_H], |
| 68 | [test $HAVE_LIBGMP != yes]) | ||
| 69 | AM_CONDITIONAL([GL_GENERATE_GMP_GMP_H], | ||
| 70 | [test $HAVE_LIBGMP = yes && test "$ac_cv_header_gmp_h" != yes]) | ||
| 67 | ]) | 71 | ]) |
diff --git a/src/alloc.c b/src/alloc.c index 12f53bdd6d8..738a35ce715 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -34,7 +34,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 34 | #include "bignum.h" | 34 | #include "bignum.h" |
| 35 | #include "dispextern.h" | 35 | #include "dispextern.h" |
| 36 | #include "intervals.h" | 36 | #include "intervals.h" |
| 37 | #include "ptr-bounds.h" | ||
| 38 | #include "puresize.h" | 37 | #include "puresize.h" |
| 39 | #include "sheap.h" | 38 | #include "sheap.h" |
| 40 | #include "sysstdio.h" | 39 | #include "sysstdio.h" |
| @@ -1624,8 +1623,7 @@ static struct Lisp_String *string_free_list; | |||
| 1624 | a pointer to the `u.data' member of its sdata structure; the | 1623 | a pointer to the `u.data' member of its sdata structure; the |
| 1625 | structure starts at a constant offset in front of that. */ | 1624 | structure starts at a constant offset in front of that. */ |
| 1626 | 1625 | ||
| 1627 | #define SDATA_OF_STRING(S) ((sdata *) ptr_bounds_init ((S)->u.s.data \ | 1626 | #define SDATA_OF_STRING(S) ((sdata *) ((S)->u.s.data - SDATA_DATA_OFFSET)) |
| 1628 | - SDATA_DATA_OFFSET)) | ||
| 1629 | 1627 | ||
| 1630 | 1628 | ||
| 1631 | #ifdef GC_CHECK_STRING_OVERRUN | 1629 | #ifdef GC_CHECK_STRING_OVERRUN |
| @@ -1799,7 +1797,7 @@ allocate_string (void) | |||
| 1799 | /* Every string on a free list should have NULL data pointer. */ | 1797 | /* Every string on a free list should have NULL data pointer. */ |
| 1800 | s->u.s.data = NULL; | 1798 | s->u.s.data = NULL; |
| 1801 | NEXT_FREE_LISP_STRING (s) = string_free_list; | 1799 | NEXT_FREE_LISP_STRING (s) = string_free_list; |
| 1802 | string_free_list = ptr_bounds_clip (s, sizeof *s); | 1800 | string_free_list = s; |
| 1803 | } | 1801 | } |
| 1804 | } | 1802 | } |
| 1805 | 1803 | ||
| @@ -1908,7 +1906,7 @@ allocate_string_data (struct Lisp_String *s, | |||
| 1908 | 1906 | ||
| 1909 | MALLOC_UNBLOCK_INPUT; | 1907 | MALLOC_UNBLOCK_INPUT; |
| 1910 | 1908 | ||
| 1911 | s->u.s.data = ptr_bounds_clip (SDATA_DATA (data), nbytes + 1); | 1909 | s->u.s.data = SDATA_DATA (data); |
| 1912 | #ifdef GC_CHECK_STRING_BYTES | 1910 | #ifdef GC_CHECK_STRING_BYTES |
| 1913 | SDATA_NBYTES (data) = nbytes; | 1911 | SDATA_NBYTES (data) = nbytes; |
| 1914 | #endif | 1912 | #endif |
| @@ -2036,7 +2034,7 @@ sweep_strings (void) | |||
| 2036 | 2034 | ||
| 2037 | /* Put the string on the free-list. */ | 2035 | /* Put the string on the free-list. */ |
| 2038 | NEXT_FREE_LISP_STRING (s) = string_free_list; | 2036 | NEXT_FREE_LISP_STRING (s) = string_free_list; |
| 2039 | string_free_list = ptr_bounds_clip (s, sizeof *s); | 2037 | string_free_list = s; |
| 2040 | ++nfree; | 2038 | ++nfree; |
| 2041 | } | 2039 | } |
| 2042 | } | 2040 | } |
| @@ -2044,7 +2042,7 @@ sweep_strings (void) | |||
| 2044 | { | 2042 | { |
| 2045 | /* S was on the free-list before. Put it there again. */ | 2043 | /* S was on the free-list before. Put it there again. */ |
| 2046 | NEXT_FREE_LISP_STRING (s) = string_free_list; | 2044 | NEXT_FREE_LISP_STRING (s) = string_free_list; |
| 2047 | string_free_list = ptr_bounds_clip (s, sizeof *s); | 2045 | string_free_list = s; |
| 2048 | ++nfree; | 2046 | ++nfree; |
| 2049 | } | 2047 | } |
| 2050 | } | 2048 | } |
| @@ -2171,8 +2169,7 @@ compact_small_strings (void) | |||
| 2171 | { | 2169 | { |
| 2172 | eassert (tb != b || to < from); | 2170 | eassert (tb != b || to < from); |
| 2173 | memmove (to, from, size + GC_STRING_EXTRA); | 2171 | memmove (to, from, size + GC_STRING_EXTRA); |
| 2174 | to->string->u.s.data | 2172 | to->string->u.s.data = SDATA_DATA (to); |
| 2175 | = ptr_bounds_clip (SDATA_DATA (to), nbytes + 1); | ||
| 2176 | } | 2173 | } |
| 2177 | 2174 | ||
| 2178 | /* Advance past the sdata we copied to. */ | 2175 | /* Advance past the sdata we copied to. */ |
| @@ -2959,7 +2956,6 @@ Lisp_Object zero_vector; | |||
| 2959 | static void | 2956 | static void |
| 2960 | setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes) | 2957 | setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes) |
| 2961 | { | 2958 | { |
| 2962 | v = ptr_bounds_clip (v, nbytes); | ||
| 2963 | eassume (header_size <= nbytes); | 2959 | eassume (header_size <= nbytes); |
| 2964 | ptrdiff_t nwords = (nbytes - header_size) / word_size; | 2960 | ptrdiff_t nwords = (nbytes - header_size) / word_size; |
| 2965 | XSETPVECTYPESIZE (v, PVEC_FREE, 0, nwords); | 2961 | XSETPVECTYPESIZE (v, PVEC_FREE, 0, nwords); |
| @@ -3327,7 +3323,7 @@ allocate_vectorlike (ptrdiff_t len, bool clearit) | |||
| 3327 | 3323 | ||
| 3328 | MALLOC_UNBLOCK_INPUT; | 3324 | MALLOC_UNBLOCK_INPUT; |
| 3329 | 3325 | ||
| 3330 | return ptr_bounds_clip (p, nbytes); | 3326 | return p; |
| 3331 | } | 3327 | } |
| 3332 | 3328 | ||
| 3333 | 3329 | ||
| @@ -4481,7 +4477,6 @@ live_string_holding (struct mem_node *m, void *p) | |||
| 4481 | must not be on the free-list. */ | 4477 | must not be on the free-list. */ |
| 4482 | if (0 <= offset && offset < sizeof b->strings) | 4478 | if (0 <= offset && offset < sizeof b->strings) |
| 4483 | { | 4479 | { |
| 4484 | cp = ptr_bounds_copy (cp, b); | ||
| 4485 | struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0]; | 4480 | struct Lisp_String *s = p = cp -= offset % sizeof b->strings[0]; |
| 4486 | if (s->u.s.data) | 4481 | if (s->u.s.data) |
| 4487 | return s; | 4482 | return s; |
| @@ -4514,7 +4509,6 @@ live_cons_holding (struct mem_node *m, void *p) | |||
| 4514 | && (b != cons_block | 4509 | && (b != cons_block |
| 4515 | || offset / sizeof b->conses[0] < cons_block_index)) | 4510 | || offset / sizeof b->conses[0] < cons_block_index)) |
| 4516 | { | 4511 | { |
| 4517 | cp = ptr_bounds_copy (cp, b); | ||
| 4518 | struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0]; | 4512 | struct Lisp_Cons *s = p = cp -= offset % sizeof b->conses[0]; |
| 4519 | if (!deadp (s->u.s.car)) | 4513 | if (!deadp (s->u.s.car)) |
| 4520 | return s; | 4514 | return s; |
| @@ -4548,7 +4542,6 @@ live_symbol_holding (struct mem_node *m, void *p) | |||
| 4548 | && (b != symbol_block | 4542 | && (b != symbol_block |
| 4549 | || offset / sizeof b->symbols[0] < symbol_block_index)) | 4543 | || offset / sizeof b->symbols[0] < symbol_block_index)) |
| 4550 | { | 4544 | { |
| 4551 | cp = ptr_bounds_copy (cp, b); | ||
| 4552 | struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0]; | 4545 | struct Lisp_Symbol *s = p = cp -= offset % sizeof b->symbols[0]; |
| 4553 | if (!deadp (s->u.s.function)) | 4546 | if (!deadp (s->u.s.function)) |
| 4554 | return s; | 4547 | return s; |
| @@ -4645,7 +4638,7 @@ mark_maybe_object (Lisp_Object obj) | |||
| 4645 | #endif | 4638 | #endif |
| 4646 | 4639 | ||
| 4647 | int type_tag = XTYPE (obj); | 4640 | int type_tag = XTYPE (obj); |
| 4648 | intptr_t offset; | 4641 | intptr_t pointer_word_tag = LISP_WORD_TAG (type_tag), offset, ipo; |
| 4649 | 4642 | ||
| 4650 | switch (type_tag) | 4643 | switch (type_tag) |
| 4651 | { | 4644 | { |
| @@ -4661,16 +4654,8 @@ mark_maybe_object (Lisp_Object obj) | |||
| 4661 | break; | 4654 | break; |
| 4662 | } | 4655 | } |
| 4663 | 4656 | ||
| 4664 | bool overflow | 4657 | INT_ADD_WRAPV ((intptr_t) XLP (obj), offset - pointer_word_tag, &ipo); |
| 4665 | = INT_SUBTRACT_WRAPV (offset, LISP_WORD_TAG (type_tag), &offset); | 4658 | void *po = (void *) ipo; |
| 4666 | #if !defined WIDE_EMACS_INT || USE_LSB_TAG | ||
| 4667 | /* If we don't use wide integers, then `intptr_t' should always be | ||
| 4668 | large enough to not overflow. Furthermore, when using the least | ||
| 4669 | significant bits as tag bits, the tag is small enough to not | ||
| 4670 | overflow either. */ | ||
| 4671 | eassert (!overflow); | ||
| 4672 | #endif | ||
| 4673 | void *po = (char *) ((intptr_t) (char *) XLP (obj) + offset); | ||
| 4674 | 4659 | ||
| 4675 | /* If the pointer is in the dump image and the dump has a record | 4660 | /* If the pointer is in the dump image and the dump has a record |
| 4676 | of the object starting at the place where the pointer points, we | 4661 | of the object starting at the place where the pointer points, we |
| @@ -4873,7 +4858,7 @@ mark_memory (void const *start, void const *end) | |||
| 4873 | 4858 | ||
| 4874 | for (pp = start; (void const *) pp < end; pp += GC_POINTER_ALIGNMENT) | 4859 | for (pp = start; (void const *) pp < end; pp += GC_POINTER_ALIGNMENT) |
| 4875 | { | 4860 | { |
| 4876 | char *p = *(char *const *) pp; | 4861 | void *p = *(void *const *) pp; |
| 4877 | mark_maybe_pointer (p); | 4862 | mark_maybe_pointer (p); |
| 4878 | 4863 | ||
| 4879 | /* Unmask any struct Lisp_Symbol pointer that make_lisp_symbol | 4864 | /* Unmask any struct Lisp_Symbol pointer that make_lisp_symbol |
| @@ -4881,8 +4866,9 @@ mark_memory (void const *start, void const *end) | |||
| 4881 | On a host with 32-bit pointers and 64-bit Lisp_Objects, | 4866 | On a host with 32-bit pointers and 64-bit Lisp_Objects, |
| 4882 | a Lisp_Object might be split into registers saved into | 4867 | a Lisp_Object might be split into registers saved into |
| 4883 | non-adjacent words and P might be the low-order word's value. */ | 4868 | non-adjacent words and P might be the low-order word's value. */ |
| 4884 | p = (char *) ((uintptr_t) p + (uintptr_t) lispsym); | 4869 | intptr_t ip; |
| 4885 | mark_maybe_pointer (p); | 4870 | INT_ADD_WRAPV ((intptr_t) p, (intptr_t) lispsym, &ip); |
| 4871 | mark_maybe_pointer ((void *) ip); | ||
| 4886 | 4872 | ||
| 4887 | verify (alignof (Lisp_Object) % GC_POINTER_ALIGNMENT == 0); | 4873 | verify (alignof (Lisp_Object) % GC_POINTER_ALIGNMENT == 0); |
| 4888 | if (alignof (Lisp_Object) == GC_POINTER_ALIGNMENT | 4874 | if (alignof (Lisp_Object) == GC_POINTER_ALIGNMENT |
| @@ -5261,7 +5247,7 @@ pure_alloc (size_t size, int type) | |||
| 5261 | pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp; | 5247 | pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp; |
| 5262 | 5248 | ||
| 5263 | if (pure_bytes_used <= pure_size) | 5249 | if (pure_bytes_used <= pure_size) |
| 5264 | return ptr_bounds_clip (result, size); | 5250 | return result; |
| 5265 | 5251 | ||
| 5266 | /* Don't allocate a large amount here, | 5252 | /* Don't allocate a large amount here, |
| 5267 | because it might get mmap'd and then its address | 5253 | because it might get mmap'd and then its address |
| @@ -5352,7 +5338,7 @@ find_string_data_in_pure (const char *data, ptrdiff_t nbytes) | |||
| 5352 | /* Check the remaining characters. */ | 5338 | /* Check the remaining characters. */ |
| 5353 | if (memcmp (data, non_lisp_beg + start, nbytes) == 0) | 5339 | if (memcmp (data, non_lisp_beg + start, nbytes) == 0) |
| 5354 | /* Found. */ | 5340 | /* Found. */ |
| 5355 | return ptr_bounds_clip (non_lisp_beg + start, nbytes + 1); | 5341 | return non_lisp_beg + start; |
| 5356 | 5342 | ||
| 5357 | start += last_char_skip; | 5343 | start += last_char_skip; |
| 5358 | } | 5344 | } |
| @@ -6076,7 +6062,6 @@ garbage_collect (void) | |||
| 6076 | stack_copy = xrealloc (stack_copy, stack_size); | 6062 | stack_copy = xrealloc (stack_copy, stack_size); |
| 6077 | stack_copy_size = stack_size; | 6063 | stack_copy_size = stack_size; |
| 6078 | } | 6064 | } |
| 6079 | stack = ptr_bounds_set (stack, stack_size); | ||
| 6080 | no_sanitize_memcpy (stack_copy, stack, stack_size); | 6065 | no_sanitize_memcpy (stack_copy, stack, stack_size); |
| 6081 | } | 6066 | } |
| 6082 | } | 6067 | } |
| @@ -6922,8 +6907,7 @@ sweep_conses (void) | |||
| 6922 | 6907 | ||
| 6923 | for (pos = start; pos < stop; pos++) | 6908 | for (pos = start; pos < stop; pos++) |
| 6924 | { | 6909 | { |
| 6925 | struct Lisp_Cons *acons | 6910 | struct Lisp_Cons *acons = &cblk->conses[pos]; |
| 6926 | = ptr_bounds_copy (&cblk->conses[pos], cblk); | ||
| 6927 | if (!XCONS_MARKED_P (acons)) | 6911 | if (!XCONS_MARKED_P (acons)) |
| 6928 | { | 6912 | { |
| 6929 | this_free++; | 6913 | this_free++; |
| @@ -6976,7 +6960,7 @@ sweep_floats (void) | |||
| 6976 | int this_free = 0; | 6960 | int this_free = 0; |
| 6977 | for (int i = 0; i < lim; i++) | 6961 | for (int i = 0; i < lim; i++) |
| 6978 | { | 6962 | { |
| 6979 | struct Lisp_Float *afloat = ptr_bounds_copy (&fblk->floats[i], fblk); | 6963 | struct Lisp_Float *afloat = &fblk->floats[i]; |
| 6980 | if (!XFLOAT_MARKED_P (afloat)) | 6964 | if (!XFLOAT_MARKED_P (afloat)) |
| 6981 | { | 6965 | { |
| 6982 | this_free++; | 6966 | this_free++; |
diff --git a/src/buffer.c b/src/buffer.c index e441499aeb0..241f2d43a93 100644 --- a/src/buffer.c +++ b/src/buffer.c | |||
| @@ -28,10 +28,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 28 | #include <stdlib.h> | 28 | #include <stdlib.h> |
| 29 | #include <unistd.h> | 29 | #include <unistd.h> |
| 30 | 30 | ||
| 31 | #ifdef HAVE_SANITIZER_LSAN_INTERFACE_H | ||
| 32 | #include <sanitizer/lsan_interface.h> | ||
| 33 | #endif | ||
| 34 | |||
| 35 | #include <verify.h> | 31 | #include <verify.h> |
| 36 | 32 | ||
| 37 | #include "lisp.h" | 33 | #include "lisp.h" |
| @@ -5087,9 +5083,7 @@ enlarge_buffer_text (struct buffer *b, ptrdiff_t delta) | |||
| 5087 | #else | 5083 | #else |
| 5088 | p = xrealloc (b->text->beg, new_nbytes); | 5084 | p = xrealloc (b->text->beg, new_nbytes); |
| 5089 | #endif | 5085 | #endif |
| 5090 | #ifdef HAVE___LSAN_IGNORE_OBJECT | ||
| 5091 | __lsan_ignore_object (p); | 5086 | __lsan_ignore_object (p); |
| 5092 | #endif | ||
| 5093 | 5087 | ||
| 5094 | if (p == NULL) | 5088 | if (p == NULL) |
| 5095 | { | 5089 | { |
diff --git a/src/bytecode.c b/src/bytecode.c index 5ac30aa1010..1913a4812a0 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -24,7 +24,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 24 | #include "character.h" | 24 | #include "character.h" |
| 25 | #include "buffer.h" | 25 | #include "buffer.h" |
| 26 | #include "keyboard.h" | 26 | #include "keyboard.h" |
| 27 | #include "ptr-bounds.h" | ||
| 28 | #include "syntax.h" | 27 | #include "syntax.h" |
| 29 | #include "window.h" | 28 | #include "window.h" |
| 30 | 29 | ||
| @@ -47,7 +46,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 47 | indirect threaded, using GCC's computed goto extension. This code, | 46 | indirect threaded, using GCC's computed goto extension. This code, |
| 48 | as currently implemented, is incompatible with BYTE_CODE_SAFE and | 47 | as currently implemented, is incompatible with BYTE_CODE_SAFE and |
| 49 | BYTE_CODE_METER. */ | 48 | BYTE_CODE_METER. */ |
| 50 | #if (defined __GNUC__ && !defined __STRICT_ANSI__ && !defined __CHKP__ \ | 49 | #if (defined __GNUC__ && !defined __STRICT_ANSI__ \ |
| 51 | && !BYTE_CODE_SAFE && !defined BYTE_CODE_METER) | 50 | && !BYTE_CODE_SAFE && !defined BYTE_CODE_METER) |
| 52 | #define BYTE_CODE_THREADED | 51 | #define BYTE_CODE_THREADED |
| 53 | #endif | 52 | #endif |
| @@ -368,14 +367,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, | |||
| 368 | USE_SAFE_ALLOCA; | 367 | USE_SAFE_ALLOCA; |
| 369 | void *alloc; | 368 | void *alloc; |
| 370 | SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length); | 369 | SAFE_ALLOCA_LISP_EXTRA (alloc, stack_items, bytestr_length); |
| 371 | ptrdiff_t item_bytes = stack_items * word_size; | 370 | Lisp_Object *stack_base = alloc; |
| 372 | Lisp_Object *stack_base = ptr_bounds_clip (alloc, item_bytes); | ||
| 373 | Lisp_Object *top = stack_base; | 371 | Lisp_Object *top = stack_base; |
| 374 | *top = vector; /* Ensure VECTOR survives GC (Bug#33014). */ | 372 | *top = vector; /* Ensure VECTOR survives GC (Bug#33014). */ |
| 375 | Lisp_Object *stack_lim = stack_base + stack_items; | 373 | Lisp_Object *stack_lim = stack_base + stack_items; |
| 376 | unsigned char *bytestr_data = alloc; | 374 | unsigned char const *bytestr_data = memcpy (stack_lim, |
| 377 | bytestr_data = ptr_bounds_clip (bytestr_data + item_bytes, bytestr_length); | 375 | SDATA (bytestr), bytestr_length); |
| 378 | memcpy (bytestr_data, SDATA (bytestr), bytestr_length); | ||
| 379 | unsigned char const *pc = bytestr_data; | 376 | unsigned char const *pc = bytestr_data; |
| 380 | ptrdiff_t count = SPECPDL_INDEX (); | 377 | ptrdiff_t count = SPECPDL_INDEX (); |
| 381 | 378 | ||
diff --git a/src/callint.c b/src/callint.c index eb916353a0c..f609c96a6fa 100644 --- a/src/callint.c +++ b/src/callint.c | |||
| @@ -21,7 +21,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 21 | #include <config.h> | 21 | #include <config.h> |
| 22 | 22 | ||
| 23 | #include "lisp.h" | 23 | #include "lisp.h" |
| 24 | #include "ptr-bounds.h" | ||
| 25 | #include "character.h" | 24 | #include "character.h" |
| 26 | #include "buffer.h" | 25 | #include "buffer.h" |
| 27 | #include "keyboard.h" | 26 | #include "keyboard.h" |
| @@ -440,9 +439,6 @@ invoke it (via an `interactive' spec that contains, for instance, an | |||
| 440 | signed char *varies = (signed char *) (visargs + nargs); | 439 | signed char *varies = (signed char *) (visargs + nargs); |
| 441 | 440 | ||
| 442 | memclear (args, nargs * (2 * word_size + 1)); | 441 | memclear (args, nargs * (2 * word_size + 1)); |
| 443 | args = ptr_bounds_clip (args, nargs * sizeof *args); | ||
| 444 | visargs = ptr_bounds_clip (visargs, nargs * sizeof *visargs); | ||
| 445 | varies = ptr_bounds_clip (varies, nargs * sizeof *varies); | ||
| 446 | 442 | ||
| 447 | if (!NILP (enable)) | 443 | if (!NILP (enable)) |
| 448 | specbind (Qenable_recursive_minibuffers, Qt); | 444 | specbind (Qenable_recursive_minibuffers, Qt); |
diff --git a/src/data.c b/src/data.c index e827695d295..33711368f13 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -23,10 +23,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 23 | #include <math.h> | 23 | #include <math.h> |
| 24 | #include <stdio.h> | 24 | #include <stdio.h> |
| 25 | 25 | ||
| 26 | #ifdef HAVE_SANITIZER_LSAN_INTERFACE_H | ||
| 27 | #include <sanitizer/lsan_interface.h> | ||
| 28 | #endif | ||
| 29 | |||
| 30 | #include <byteswap.h> | 26 | #include <byteswap.h> |
| 31 | #include <count-one-bits.h> | 27 | #include <count-one-bits.h> |
| 32 | #include <count-trailing-zeros.h> | 28 | #include <count-trailing-zeros.h> |
| @@ -1834,9 +1830,7 @@ make_blv (struct Lisp_Symbol *sym, bool forwarded, | |||
| 1834 | set_blv_defcell (blv, tem); | 1830 | set_blv_defcell (blv, tem); |
| 1835 | set_blv_valcell (blv, tem); | 1831 | set_blv_valcell (blv, tem); |
| 1836 | set_blv_found (blv, false); | 1832 | set_blv_found (blv, false); |
| 1837 | #ifdef HAVE___LSAN_IGNORE_OBJECT | ||
| 1838 | __lsan_ignore_object (blv); | 1833 | __lsan_ignore_object (blv); |
| 1839 | #endif | ||
| 1840 | return blv; | 1834 | return blv; |
| 1841 | } | 1835 | } |
| 1842 | 1836 | ||
diff --git a/src/dispnew.c b/src/dispnew.c index 1ae59e3ff2b..d318e26308e 100644 --- a/src/dispnew.c +++ b/src/dispnew.c | |||
| @@ -25,7 +25,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 25 | #include <unistd.h> | 25 | #include <unistd.h> |
| 26 | 26 | ||
| 27 | #include "lisp.h" | 27 | #include "lisp.h" |
| 28 | #include "ptr-bounds.h" | ||
| 29 | #include "termchar.h" | 28 | #include "termchar.h" |
| 30 | /* cm.h must come after dispextern.h on Windows. */ | 29 | /* cm.h must come after dispextern.h on Windows. */ |
| 31 | #include "dispextern.h" | 30 | #include "dispextern.h" |
| @@ -4891,12 +4890,6 @@ scrolling (struct frame *frame) | |||
| 4891 | unsigned *new_hash = old_hash + height; | 4890 | unsigned *new_hash = old_hash + height; |
| 4892 | int *draw_cost = (int *) (new_hash + height); | 4891 | int *draw_cost = (int *) (new_hash + height); |
| 4893 | int *old_draw_cost = draw_cost + height; | 4892 | int *old_draw_cost = draw_cost + height; |
| 4894 | old_hash = ptr_bounds_clip (old_hash, height * sizeof *old_hash); | ||
| 4895 | new_hash = ptr_bounds_clip (new_hash, height * sizeof *new_hash); | ||
| 4896 | draw_cost = ptr_bounds_clip (draw_cost, height * sizeof *draw_cost); | ||
| 4897 | old_draw_cost = ptr_bounds_clip (old_draw_cost, | ||
| 4898 | height * sizeof *old_draw_cost); | ||
| 4899 | |||
| 4900 | eassert (current_matrix); | 4893 | eassert (current_matrix); |
| 4901 | 4894 | ||
| 4902 | /* Compute hash codes of all the lines. Also calculate number of | 4895 | /* Compute hash codes of all the lines. Also calculate number of |
diff --git a/src/editfns.c b/src/editfns.c index 763d95bb8fa..cb09ea8a31a 100644 --- a/src/editfns.c +++ b/src/editfns.c | |||
| @@ -46,7 +46,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 46 | 46 | ||
| 47 | #include "composite.h" | 47 | #include "composite.h" |
| 48 | #include "intervals.h" | 48 | #include "intervals.h" |
| 49 | #include "ptr-bounds.h" | ||
| 50 | #include "systime.h" | 49 | #include "systime.h" |
| 51 | #include "character.h" | 50 | #include "character.h" |
| 52 | #include "buffer.h" | 51 | #include "buffer.h" |
| @@ -3131,8 +3130,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) | |||
| 3131 | string was not copied into the output. | 3130 | string was not copied into the output. |
| 3132 | It is 2 if byte I was not the first byte of its character. */ | 3131 | It is 2 if byte I was not the first byte of its character. */ |
| 3133 | char *discarded = (char *) &info[nspec_bound]; | 3132 | char *discarded = (char *) &info[nspec_bound]; |
| 3134 | info = ptr_bounds_clip (info, info_size); | ||
| 3135 | discarded = ptr_bounds_clip (discarded, formatlen); | ||
| 3136 | memset (discarded, 0, formatlen); | 3133 | memset (discarded, 0, formatlen); |
| 3137 | 3134 | ||
| 3138 | /* Try to determine whether the result should be multibyte. | 3135 | /* Try to determine whether the result should be multibyte. |
diff --git a/src/emacs-module.c b/src/emacs-module.c index f57101946b3..a0bab118019 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c | |||
| @@ -84,10 +84,6 @@ To add a new module function, proceed as follows: | |||
| 84 | #include <stdlib.h> | 84 | #include <stdlib.h> |
| 85 | #include <time.h> | 85 | #include <time.h> |
| 86 | 86 | ||
| 87 | #ifdef HAVE_SANITIZER_LSAN_INTERFACE_H | ||
| 88 | #include <sanitizer/lsan_interface.h> | ||
| 89 | #endif | ||
| 90 | |||
| 91 | #include "lisp.h" | 87 | #include "lisp.h" |
| 92 | #include "bignum.h" | 88 | #include "bignum.h" |
| 93 | #include "dynlib.h" | 89 | #include "dynlib.h" |
| @@ -1103,9 +1099,7 @@ DEFUN ("module-load", Fmodule_load, Smodule_load, 1, 1, 0, | |||
| 1103 | if (module_assertions) | 1099 | if (module_assertions) |
| 1104 | { | 1100 | { |
| 1105 | rt = xmalloc (sizeof *rt); | 1101 | rt = xmalloc (sizeof *rt); |
| 1106 | #ifdef HAVE___LSAN_IGNORE_OBJECT | ||
| 1107 | __lsan_ignore_object (rt); | 1102 | __lsan_ignore_object (rt); |
| 1108 | #endif | ||
| 1109 | } | 1103 | } |
| 1110 | else | 1104 | else |
| 1111 | rt = &rt_pub; | 1105 | rt = &rt_pub; |
| @@ -1426,9 +1420,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv) | |||
| 1426 | if (module_assertions) | 1420 | if (module_assertions) |
| 1427 | { | 1421 | { |
| 1428 | env = xmalloc (sizeof *env); | 1422 | env = xmalloc (sizeof *env); |
| 1429 | #ifdef HAVE___LSAN_IGNORE_OBJECT | ||
| 1430 | __lsan_ignore_object (env); | 1423 | __lsan_ignore_object (env); |
| 1431 | #endif | ||
| 1432 | } | 1424 | } |
| 1433 | 1425 | ||
| 1434 | priv->pending_non_local_exit = emacs_funcall_exit_return; | 1426 | priv->pending_non_local_exit = emacs_funcall_exit_return; |
diff --git a/src/emacs.c b/src/emacs.c index 34717cdae2f..8c252276352 100644 --- a/src/emacs.c +++ b/src/emacs.c | |||
| @@ -83,7 +83,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 83 | #include "charset.h" | 83 | #include "charset.h" |
| 84 | #include "composite.h" | 84 | #include "composite.h" |
| 85 | #include "dispextern.h" | 85 | #include "dispextern.h" |
| 86 | #include "ptr-bounds.h" | ||
| 87 | #include "regex-emacs.h" | 86 | #include "regex-emacs.h" |
| 88 | #include "sheap.h" | 87 | #include "sheap.h" |
| 89 | #include "syntax.h" | 88 | #include "syntax.h" |
diff --git a/src/frame.c b/src/frame.c index c871e4fd994..c4dfc35a0c5 100644 --- a/src/frame.c +++ b/src/frame.c | |||
| @@ -35,7 +35,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 35 | #include "buffer.h" | 35 | #include "buffer.h" |
| 36 | /* These help us bind and responding to switch-frame events. */ | 36 | /* These help us bind and responding to switch-frame events. */ |
| 37 | #include "keyboard.h" | 37 | #include "keyboard.h" |
| 38 | #include "ptr-bounds.h" | ||
| 39 | #include "frame.h" | 38 | #include "frame.h" |
| 40 | #include "blockinput.h" | 39 | #include "blockinput.h" |
| 41 | #include "termchar.h" | 40 | #include "termchar.h" |
| @@ -2566,21 +2565,18 @@ before calling this function on it, like this. | |||
| 2566 | if (FRAME_WINDOW_P (XFRAME (frame))) | 2565 | if (FRAME_WINDOW_P (XFRAME (frame))) |
| 2567 | /* Warping the mouse will cause enternotify and focus events. */ | 2566 | /* Warping the mouse will cause enternotify and focus events. */ |
| 2568 | frame_set_mouse_position (XFRAME (frame), xval, yval); | 2567 | frame_set_mouse_position (XFRAME (frame), xval, yval); |
| 2569 | #else | 2568 | #elif defined MSDOS |
| 2570 | #if defined (MSDOS) | ||
| 2571 | if (FRAME_MSDOS_P (XFRAME (frame))) | 2569 | if (FRAME_MSDOS_P (XFRAME (frame))) |
| 2572 | { | 2570 | { |
| 2573 | Fselect_frame (frame, Qnil); | 2571 | Fselect_frame (frame, Qnil); |
| 2574 | mouse_moveto (xval, yval); | 2572 | mouse_moveto (xval, yval); |
| 2575 | } | 2573 | } |
| 2574 | #elif defined HAVE_GPM | ||
| 2575 | Fselect_frame (frame, Qnil); | ||
| 2576 | term_mouse_moveto (xval, yval); | ||
| 2576 | #else | 2577 | #else |
| 2577 | #ifdef HAVE_GPM | 2578 | (void) xval; |
| 2578 | { | 2579 | (void) yval; |
| 2579 | Fselect_frame (frame, Qnil); | ||
| 2580 | term_mouse_moveto (xval, yval); | ||
| 2581 | } | ||
| 2582 | #endif | ||
| 2583 | #endif | ||
| 2584 | #endif | 2580 | #endif |
| 2585 | 2581 | ||
| 2586 | return Qnil; | 2582 | return Qnil; |
| @@ -2607,21 +2603,18 @@ before calling this function on it, like this. | |||
| 2607 | if (FRAME_WINDOW_P (XFRAME (frame))) | 2603 | if (FRAME_WINDOW_P (XFRAME (frame))) |
| 2608 | /* Warping the mouse will cause enternotify and focus events. */ | 2604 | /* Warping the mouse will cause enternotify and focus events. */ |
| 2609 | frame_set_mouse_pixel_position (XFRAME (frame), xval, yval); | 2605 | frame_set_mouse_pixel_position (XFRAME (frame), xval, yval); |
| 2610 | #else | 2606 | #elif defined MSDOS |
| 2611 | #if defined (MSDOS) | ||
| 2612 | if (FRAME_MSDOS_P (XFRAME (frame))) | 2607 | if (FRAME_MSDOS_P (XFRAME (frame))) |
| 2613 | { | 2608 | { |
| 2614 | Fselect_frame (frame, Qnil); | 2609 | Fselect_frame (frame, Qnil); |
| 2615 | mouse_moveto (xval, yval); | 2610 | mouse_moveto (xval, yval); |
| 2616 | } | 2611 | } |
| 2612 | #elif defined HAVE_GPM | ||
| 2613 | Fselect_frame (frame, Qnil); | ||
| 2614 | term_mouse_moveto (xval, yval); | ||
| 2617 | #else | 2615 | #else |
| 2618 | #ifdef HAVE_GPM | 2616 | (void) xval; |
| 2619 | { | 2617 | (void) yval; |
| 2620 | Fselect_frame (frame, Qnil); | ||
| 2621 | term_mouse_moveto (xval, yval); | ||
| 2622 | } | ||
| 2623 | #endif | ||
| 2624 | #endif | ||
| 2625 | #endif | 2618 | #endif |
| 2626 | 2619 | ||
| 2627 | return Qnil; | 2620 | return Qnil; |
| @@ -3658,6 +3651,9 @@ bottom edge of FRAME's display. */) | |||
| 3658 | #ifdef HAVE_WINDOW_SYSTEM | 3651 | #ifdef HAVE_WINDOW_SYSTEM |
| 3659 | if (FRAME_TERMINAL (f)->set_frame_offset_hook) | 3652 | if (FRAME_TERMINAL (f)->set_frame_offset_hook) |
| 3660 | FRAME_TERMINAL (f)->set_frame_offset_hook (f, xval, yval, 1); | 3653 | FRAME_TERMINAL (f)->set_frame_offset_hook (f, xval, yval, 1); |
| 3654 | #else | ||
| 3655 | (void) xval; | ||
| 3656 | (void) yval; | ||
| 3661 | #endif | 3657 | #endif |
| 3662 | } | 3658 | } |
| 3663 | 3659 | ||
| @@ -5019,8 +5015,6 @@ gui_display_get_resource (Display_Info *dpyinfo, Lisp_Object attribute, | |||
| 5019 | USE_SAFE_ALLOCA; | 5015 | USE_SAFE_ALLOCA; |
| 5020 | char *name_key = SAFE_ALLOCA (name_keysize + class_keysize); | 5016 | char *name_key = SAFE_ALLOCA (name_keysize + class_keysize); |
| 5021 | char *class_key = name_key + name_keysize; | 5017 | char *class_key = name_key + name_keysize; |
| 5022 | name_key = ptr_bounds_clip (name_key, name_keysize); | ||
| 5023 | class_key = ptr_bounds_clip (class_key, class_keysize); | ||
| 5024 | 5018 | ||
| 5025 | /* Start with emacs.FRAMENAME for the name (the specific one) | 5019 | /* Start with emacs.FRAMENAME for the name (the specific one) |
| 5026 | and with `Emacs' for the class key (the general one). */ | 5020 | and with `Emacs' for the class key (the general one). */ |
| @@ -5091,9 +5085,6 @@ x_get_resource_string (const char *attribute, const char *class) | |||
| 5091 | ptrdiff_t class_keysize = sizeof (EMACS_CLASS) - 1 + strlen (class) + 2; | 5085 | ptrdiff_t class_keysize = sizeof (EMACS_CLASS) - 1 + strlen (class) + 2; |
| 5092 | char *name_key = SAFE_ALLOCA (name_keysize + class_keysize); | 5086 | char *name_key = SAFE_ALLOCA (name_keysize + class_keysize); |
| 5093 | char *class_key = name_key + name_keysize; | 5087 | char *class_key = name_key + name_keysize; |
| 5094 | name_key = ptr_bounds_clip (name_key, name_keysize); | ||
| 5095 | class_key = ptr_bounds_clip (class_key, class_keysize); | ||
| 5096 | |||
| 5097 | esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute); | 5088 | esprintf (name_key, "%s.%s", SSDATA (Vinvocation_name), attribute); |
| 5098 | sprintf (class_key, "%s.%s", EMACS_CLASS, class); | 5089 | sprintf (class_key, "%s.%s", EMACS_CLASS, class); |
| 5099 | 5090 | ||
diff --git a/src/fringe.c b/src/fringe.c index fc4c738dc2d..c3d64fefc82 100644 --- a/src/fringe.c +++ b/src/fringe.c | |||
| @@ -23,7 +23,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 23 | 23 | ||
| 24 | #include "lisp.h" | 24 | #include "lisp.h" |
| 25 | #include "frame.h" | 25 | #include "frame.h" |
| 26 | #include "ptr-bounds.h" | ||
| 27 | #include "window.h" | 26 | #include "window.h" |
| 28 | #include "dispextern.h" | 27 | #include "dispextern.h" |
| 29 | #include "buffer.h" | 28 | #include "buffer.h" |
| @@ -1607,9 +1606,7 @@ If BITMAP already exists, the existing definition is replaced. */) | |||
| 1607 | fb.dynamic = true; | 1606 | fb.dynamic = true; |
| 1608 | 1607 | ||
| 1609 | xfb = xmalloc (sizeof fb + fb.height * BYTES_PER_BITMAP_ROW); | 1608 | xfb = xmalloc (sizeof fb + fb.height * BYTES_PER_BITMAP_ROW); |
| 1610 | fb.bits = b = ((unsigned short *) | 1609 | fb.bits = b = (unsigned short *) (xfb + 1); |
| 1611 | ptr_bounds_clip (xfb + 1, fb.height * BYTES_PER_BITMAP_ROW)); | ||
| 1612 | xfb = ptr_bounds_clip (xfb, sizeof *xfb); | ||
| 1613 | 1610 | ||
| 1614 | j = 0; | 1611 | j = 0; |
| 1615 | while (j < fb.height) | 1612 | while (j < fb.height) |
diff --git a/src/gmalloc.c b/src/gmalloc.c index 8450a639e77..3560c744539 100644 --- a/src/gmalloc.c +++ b/src/gmalloc.c | |||
| @@ -38,8 +38,6 @@ License along with this library. If not, see <https://www.gnu.org/licenses/>. | |||
| 38 | 38 | ||
| 39 | #include "lisp.h" | 39 | #include "lisp.h" |
| 40 | 40 | ||
| 41 | #include "ptr-bounds.h" | ||
| 42 | |||
| 43 | #ifdef HAVE_MALLOC_H | 41 | #ifdef HAVE_MALLOC_H |
| 44 | # if GNUC_PREREQ (4, 2, 0) | 42 | # if GNUC_PREREQ (4, 2, 0) |
| 45 | # pragma GCC diagnostic ignored "-Wdeprecated-declarations" | 43 | # pragma GCC diagnostic ignored "-Wdeprecated-declarations" |
| @@ -200,8 +198,7 @@ extern size_t _bytes_free; | |||
| 200 | 198 | ||
| 201 | /* Internal versions of `malloc', `realloc', and `free' | 199 | /* Internal versions of `malloc', `realloc', and `free' |
| 202 | used when these functions need to call each other. | 200 | used when these functions need to call each other. |
| 203 | They are the same but don't call the hooks | 201 | They are the same but don't call the hooks. */ |
| 204 | and don't bound the resulting pointers. */ | ||
| 205 | extern void *_malloc_internal (size_t); | 202 | extern void *_malloc_internal (size_t); |
| 206 | extern void *_realloc_internal (void *, size_t); | 203 | extern void *_realloc_internal (void *, size_t); |
| 207 | extern void _free_internal (void *); | 204 | extern void _free_internal (void *); |
| @@ -551,7 +548,7 @@ malloc_initialize_1 (void) | |||
| 551 | _heapinfo[0].free.size = 0; | 548 | _heapinfo[0].free.size = 0; |
| 552 | _heapinfo[0].free.next = _heapinfo[0].free.prev = 0; | 549 | _heapinfo[0].free.next = _heapinfo[0].free.prev = 0; |
| 553 | _heapindex = 0; | 550 | _heapindex = 0; |
| 554 | _heapbase = (char *) ptr_bounds_init (_heapinfo); | 551 | _heapbase = (char *) _heapinfo; |
| 555 | _heaplimit = BLOCK (_heapbase + heapsize * sizeof (malloc_info)); | 552 | _heaplimit = BLOCK (_heapbase + heapsize * sizeof (malloc_info)); |
| 556 | 553 | ||
| 557 | register_heapinfo (); | 554 | register_heapinfo (); |
| @@ -912,8 +909,7 @@ malloc (size_t size) | |||
| 912 | among multiple threads. We just leave it for compatibility with | 909 | among multiple threads. We just leave it for compatibility with |
| 913 | glibc malloc (i.e., assignments to gmalloc_hook) for now. */ | 910 | glibc malloc (i.e., assignments to gmalloc_hook) for now. */ |
| 914 | hook = gmalloc_hook; | 911 | hook = gmalloc_hook; |
| 915 | void *result = (hook ? hook : _malloc_internal) (size); | 912 | return (hook ? hook : _malloc_internal) (size); |
| 916 | return ptr_bounds_clip (result, size); | ||
| 917 | } | 913 | } |
| 918 | 914 | ||
| 919 | #if !(defined (_LIBC) || defined (HYBRID_MALLOC)) | 915 | #if !(defined (_LIBC) || defined (HYBRID_MALLOC)) |
| @@ -991,7 +987,6 @@ _free_internal_nolock (void *ptr) | |||
| 991 | 987 | ||
| 992 | if (ptr == NULL) | 988 | if (ptr == NULL) |
| 993 | return; | 989 | return; |
| 994 | ptr = ptr_bounds_init (ptr); | ||
| 995 | 990 | ||
| 996 | PROTECT_MALLOC_STATE (0); | 991 | PROTECT_MALLOC_STATE (0); |
| 997 | 992 | ||
| @@ -1303,7 +1298,6 @@ _realloc_internal_nolock (void *ptr, size_t size) | |||
| 1303 | else if (ptr == NULL) | 1298 | else if (ptr == NULL) |
| 1304 | return _malloc_internal_nolock (size); | 1299 | return _malloc_internal_nolock (size); |
| 1305 | 1300 | ||
| 1306 | ptr = ptr_bounds_init (ptr); | ||
| 1307 | block = BLOCK (ptr); | 1301 | block = BLOCK (ptr); |
| 1308 | 1302 | ||
| 1309 | PROTECT_MALLOC_STATE (0); | 1303 | PROTECT_MALLOC_STATE (0); |
| @@ -1426,8 +1420,7 @@ realloc (void *ptr, size_t size) | |||
| 1426 | return NULL; | 1420 | return NULL; |
| 1427 | 1421 | ||
| 1428 | hook = grealloc_hook; | 1422 | hook = grealloc_hook; |
| 1429 | void *result = (hook ? hook : _realloc_internal) (ptr, size); | 1423 | return (hook ? hook : _realloc_internal) (ptr, size); |
| 1430 | return ptr_bounds_clip (result, size); | ||
| 1431 | } | 1424 | } |
| 1432 | /* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc. | 1425 | /* Copyright (C) 1991, 1992, 1994 Free Software Foundation, Inc. |
| 1433 | 1426 | ||
| @@ -1601,7 +1594,6 @@ aligned_alloc (size_t alignment, size_t size) | |||
| 1601 | { | 1594 | { |
| 1602 | l->exact = result; | 1595 | l->exact = result; |
| 1603 | result = l->aligned = (char *) result + adj; | 1596 | result = l->aligned = (char *) result + adj; |
| 1604 | result = ptr_bounds_clip (result, size); | ||
| 1605 | } | 1597 | } |
| 1606 | UNLOCK_ALIGNED_BLOCKS (); | 1598 | UNLOCK_ALIGNED_BLOCKS (); |
| 1607 | if (l == NULL) | 1599 | if (l == NULL) |
diff --git a/src/image.c b/src/image.c index e7e0a93313b..e236b389210 100644 --- a/src/image.c +++ b/src/image.c | |||
| @@ -259,6 +259,8 @@ cr_put_image_to_cr_data (struct image *img) | |||
| 259 | cairo_matrix_t matrix; | 259 | cairo_matrix_t matrix; |
| 260 | cairo_pattern_get_matrix (img->cr_data, &matrix); | 260 | cairo_pattern_get_matrix (img->cr_data, &matrix); |
| 261 | cairo_pattern_set_matrix (pattern, &matrix); | 261 | cairo_pattern_set_matrix (pattern, &matrix); |
| 262 | cairo_pattern_set_filter | ||
| 263 | (pattern, cairo_pattern_get_filter (img->cr_data)); | ||
| 262 | cairo_pattern_destroy (img->cr_data); | 264 | cairo_pattern_destroy (img->cr_data); |
| 263 | } | 265 | } |
| 264 | cairo_surface_destroy (surface); | 266 | cairo_surface_destroy (surface); |
| @@ -2114,6 +2116,15 @@ image_set_transform (struct frame *f, struct image *img) | |||
| 2114 | double rotation = 0.0; | 2116 | double rotation = 0.0; |
| 2115 | compute_image_rotation (img, &rotation); | 2117 | compute_image_rotation (img, &rotation); |
| 2116 | 2118 | ||
| 2119 | # if defined USE_CAIRO || defined HAVE_XRENDER || defined HAVE_NS | ||
| 2120 | /* We want scale up operations to use a nearest neighbour filter to | ||
| 2121 | show real pixels instead of munging them, but scale down | ||
| 2122 | operations to use a blended filter, to avoid aliasing and the like. | ||
| 2123 | |||
| 2124 | TODO: implement for Windows. */ | ||
| 2125 | bool scale_down = (width < img->width) || (height < img->height); | ||
| 2126 | # endif | ||
| 2127 | |||
| 2117 | /* Perform scale transformation. */ | 2128 | /* Perform scale transformation. */ |
| 2118 | 2129 | ||
| 2119 | matrix3x3 matrix | 2130 | matrix3x3 matrix |
| @@ -2225,11 +2236,14 @@ image_set_transform (struct frame *f, struct image *img) | |||
| 2225 | /* Under NS the transform is applied to the drawing surface at | 2236 | /* Under NS the transform is applied to the drawing surface at |
| 2226 | drawing time, so store it for later. */ | 2237 | drawing time, so store it for later. */ |
| 2227 | ns_image_set_transform (img->pixmap, matrix); | 2238 | ns_image_set_transform (img->pixmap, matrix); |
| 2239 | ns_image_set_smoothing (img->pixmap, scale_down); | ||
| 2228 | # elif defined USE_CAIRO | 2240 | # elif defined USE_CAIRO |
| 2229 | cairo_matrix_t cr_matrix = {matrix[0][0], matrix[0][1], matrix[1][0], | 2241 | cairo_matrix_t cr_matrix = {matrix[0][0], matrix[0][1], matrix[1][0], |
| 2230 | matrix[1][1], matrix[2][0], matrix[2][1]}; | 2242 | matrix[1][1], matrix[2][0], matrix[2][1]}; |
| 2231 | cairo_pattern_t *pattern = cairo_pattern_create_rgb (0, 0, 0); | 2243 | cairo_pattern_t *pattern = cairo_pattern_create_rgb (0, 0, 0); |
| 2232 | cairo_pattern_set_matrix (pattern, &cr_matrix); | 2244 | cairo_pattern_set_matrix (pattern, &cr_matrix); |
| 2245 | cairo_pattern_set_filter (pattern, scale_down | ||
| 2246 | ? CAIRO_FILTER_BEST : CAIRO_FILTER_NEAREST); | ||
| 2233 | /* Dummy solid color pattern just to record pattern matrix. */ | 2247 | /* Dummy solid color pattern just to record pattern matrix. */ |
| 2234 | img->cr_data = pattern; | 2248 | img->cr_data = pattern; |
| 2235 | # elif defined (HAVE_XRENDER) | 2249 | # elif defined (HAVE_XRENDER) |
| @@ -2246,14 +2260,14 @@ image_set_transform (struct frame *f, struct image *img) | |||
| 2246 | XDoubleToFixed (matrix[1][2]), | 2260 | XDoubleToFixed (matrix[1][2]), |
| 2247 | XDoubleToFixed (matrix[2][2])}}}; | 2261 | XDoubleToFixed (matrix[2][2])}}}; |
| 2248 | 2262 | ||
| 2249 | XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->picture, FilterBest, | 2263 | XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->picture, |
| 2250 | 0, 0); | 2264 | scale_down ? FilterBest : FilterNearest, 0, 0); |
| 2251 | XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->picture, &tmat); | 2265 | XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->picture, &tmat); |
| 2252 | 2266 | ||
| 2253 | if (img->mask_picture) | 2267 | if (img->mask_picture) |
| 2254 | { | 2268 | { |
| 2255 | XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->mask_picture, | 2269 | XRenderSetPictureFilter (FRAME_X_DISPLAY (f), img->mask_picture, |
| 2256 | FilterBest, 0, 0); | 2270 | scale_down ? FilterBest : FilterNearest, 0, 0); |
| 2257 | XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->mask_picture, | 2271 | XRenderSetPictureTransform (FRAME_X_DISPLAY (f), img->mask_picture, |
| 2258 | &tmat); | 2272 | &tmat); |
| 2259 | } | 2273 | } |
diff --git a/src/lisp.h b/src/lisp.h index 5ef31eff31e..75ef6d30f97 100644 --- a/src/lisp.h +++ b/src/lisp.h | |||
| @@ -894,8 +894,8 @@ verify (GCALIGNED (struct Lisp_Symbol)); | |||
| 894 | convert it to a Lisp_Word. */ | 894 | convert it to a Lisp_Word. */ |
| 895 | #if LISP_WORDS_ARE_POINTERS | 895 | #if LISP_WORDS_ARE_POINTERS |
| 896 | /* untagged_ptr is a pointer so that the compiler knows that TAG_PTR | 896 | /* untagged_ptr is a pointer so that the compiler knows that TAG_PTR |
| 897 | yields a pointer; this can help with gcc -fcheck-pointer-bounds. | 897 | yields a pointer. It is char * so that adding a tag uses simple |
| 898 | It is char * so that adding a tag uses simple machine addition. */ | 898 | machine addition. */ |
| 899 | typedef char *untagged_ptr; | 899 | typedef char *untagged_ptr; |
| 900 | typedef uintptr_t Lisp_Word_tag; | 900 | typedef uintptr_t Lisp_Word_tag; |
| 901 | #else | 901 | #else |
| @@ -923,13 +923,9 @@ typedef EMACS_UINT Lisp_Word_tag; | |||
| 923 | when using a debugger like GDB, on older platforms where the debug | 923 | when using a debugger like GDB, on older platforms where the debug |
| 924 | format does not represent C macros. However, they are unbounded | 924 | format does not represent C macros. However, they are unbounded |
| 925 | and would just be asking for trouble if checking pointer bounds. */ | 925 | and would just be asking for trouble if checking pointer bounds. */ |
| 926 | #ifdef __CHKP__ | 926 | #define DEFINE_LISP_SYMBOL(name) \ |
| 927 | # define DEFINE_LISP_SYMBOL(name) | 927 | DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \ |
| 928 | #else | 928 | DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name)) |
| 929 | # define DEFINE_LISP_SYMBOL(name) \ | ||
| 930 | DEFINE_GDB_SYMBOL_BEGIN (Lisp_Object, name) \ | ||
| 931 | DEFINE_GDB_SYMBOL_END (LISPSYM_INITIALLY (name)) | ||
| 932 | #endif | ||
| 933 | 929 | ||
| 934 | /* The index of the C-defined Lisp symbol SYM. | 930 | /* The index of the C-defined Lisp symbol SYM. |
| 935 | This can be used in a static initializer. */ | 931 | This can be used in a static initializer. */ |
| @@ -1003,30 +999,15 @@ XSYMBOL (Lisp_Object a) | |||
| 1003 | eassert (SYMBOLP (a)); | 999 | eassert (SYMBOLP (a)); |
| 1004 | intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol); | 1000 | intptr_t i = (intptr_t) XUNTAG (a, Lisp_Symbol, struct Lisp_Symbol); |
| 1005 | void *p = (char *) lispsym + i; | 1001 | void *p = (char *) lispsym + i; |
| 1006 | #ifdef __CHKP__ | ||
| 1007 | /* Bypass pointer checking. Although this could be improved it is | ||
| 1008 | probably not worth the trouble. */ | ||
| 1009 | p = __builtin___bnd_set_ptr_bounds (p, sizeof (struct Lisp_Symbol)); | ||
| 1010 | #endif | ||
| 1011 | return p; | 1002 | return p; |
| 1012 | } | 1003 | } |
| 1013 | 1004 | ||
| 1014 | INLINE Lisp_Object | 1005 | INLINE Lisp_Object |
| 1015 | make_lisp_symbol (struct Lisp_Symbol *sym) | 1006 | make_lisp_symbol (struct Lisp_Symbol *sym) |
| 1016 | { | 1007 | { |
| 1017 | #ifdef __CHKP__ | 1008 | /* GCC 7 x86-64 generates faster code if lispsym is |
| 1018 | /* Although '__builtin___bnd_narrow_ptr_bounds (sym, sym, sizeof *sym)' | ||
| 1019 | should be more efficient, it runs afoul of GCC bug 83251 | ||
| 1020 | <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=83251>. | ||
| 1021 | Also, attempting to call __builtin___bnd_chk_ptr_bounds (sym, sizeof *sym) | ||
| 1022 | here seems to trigger a GCC bug, as yet undiagnosed. */ | ||
| 1023 | char *addr = __builtin___bnd_set_ptr_bounds (sym, sizeof *sym); | ||
| 1024 | char *symoffset = addr - (intptr_t) lispsym; | ||
| 1025 | #else | ||
| 1026 | /* If !__CHKP__, GCC 7 x86-64 generates faster code if lispsym is | ||
| 1027 | cast to char * rather than to intptr_t. */ | 1009 | cast to char * rather than to intptr_t. */ |
| 1028 | char *symoffset = (char *) ((char *) sym - (char *) lispsym); | 1010 | char *symoffset = (char *) ((char *) sym - (char *) lispsym); |
| 1029 | #endif | ||
| 1030 | Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); | 1011 | Lisp_Object a = TAG_PTR (Lisp_Symbol, symoffset); |
| 1031 | eassert (XSYMBOL (a) == sym); | 1012 | eassert (XSYMBOL (a) == sym); |
| 1032 | return a; | 1013 | return a; |
| @@ -4837,6 +4818,17 @@ lispstpcpy (char *dest, Lisp_Object string) | |||
| 4837 | return dest + len; | 4818 | return dest + len; |
| 4838 | } | 4819 | } |
| 4839 | 4820 | ||
| 4821 | #if (defined HAVE___LSAN_IGNORE_OBJECT \ | ||
| 4822 | && defined HAVE_SANITIZER_LSAN_INTERFACE_H) | ||
| 4823 | # include <sanitizer/lsan_interface.h> | ||
| 4824 | #else | ||
| 4825 | /* Treat *P as a non-leak. */ | ||
| 4826 | INLINE void | ||
| 4827 | __lsan_ignore_object (void const *p) | ||
| 4828 | { | ||
| 4829 | } | ||
| 4830 | #endif | ||
| 4831 | |||
| 4840 | extern void xputenv (const char *); | 4832 | extern void xputenv (const char *); |
| 4841 | 4833 | ||
| 4842 | extern char *egetenv_internal (const char *, ptrdiff_t); | 4834 | extern char *egetenv_internal (const char *, ptrdiff_t); |
diff --git a/src/nsimage.m b/src/nsimage.m index 07750de95fe..966e7044f12 100644 --- a/src/nsimage.m +++ b/src/nsimage.m | |||
| @@ -199,6 +199,12 @@ ns_image_set_transform (void *img, double m[3][3]) | |||
| 199 | [(EmacsImage *)img setTransform:m]; | 199 | [(EmacsImage *)img setTransform:m]; |
| 200 | } | 200 | } |
| 201 | 201 | ||
| 202 | void | ||
| 203 | ns_image_set_smoothing (void *img, bool smooth) | ||
| 204 | { | ||
| 205 | [(EmacsImage *)img setSmoothing:smooth]; | ||
| 206 | } | ||
| 207 | |||
| 202 | unsigned long | 208 | unsigned long |
| 203 | ns_get_pixel (void *img, int x, int y) | 209 | ns_get_pixel (void *img, int x, int y) |
| 204 | { | 210 | { |
| @@ -591,4 +597,10 @@ ns_set_alpha (void *img, int x, int y, unsigned char a) | |||
| 591 | [transform setTransformStruct:tm]; | 597 | [transform setTransformStruct:tm]; |
| 592 | } | 598 | } |
| 593 | 599 | ||
| 600 | - (void)setSmoothing: (BOOL) s | ||
| 601 | { | ||
| 602 | smoothing = s; | ||
| 603 | } | ||
| 604 | |||
| 605 | |||
| 594 | @end | 606 | @end |
diff --git a/src/nsterm.h b/src/nsterm.h index 8d5371c8f24..a511fef5b98 100644 --- a/src/nsterm.h +++ b/src/nsterm.h | |||
| @@ -640,6 +640,7 @@ typedef id instancetype; | |||
| 640 | unsigned long xbm_fg; | 640 | unsigned long xbm_fg; |
| 641 | @public | 641 | @public |
| 642 | NSAffineTransform *transform; | 642 | NSAffineTransform *transform; |
| 643 | BOOL smoothing; | ||
| 643 | } | 644 | } |
| 644 | + (instancetype)allocInitFromFile: (Lisp_Object)file; | 645 | + (instancetype)allocInitFromFile: (Lisp_Object)file; |
| 645 | - (void)dealloc; | 646 | - (void)dealloc; |
| @@ -658,6 +659,7 @@ typedef id instancetype; | |||
| 658 | - (Lisp_Object)getMetadata; | 659 | - (Lisp_Object)getMetadata; |
| 659 | - (BOOL)setFrame: (unsigned int) index; | 660 | - (BOOL)setFrame: (unsigned int) index; |
| 660 | - (void)setTransform: (double[3][3]) m; | 661 | - (void)setTransform: (double[3][3]) m; |
| 662 | - (void)setSmoothing: (BOOL)s; | ||
| 661 | @end | 663 | @end |
| 662 | 664 | ||
| 663 | 665 | ||
| @@ -1200,6 +1202,7 @@ extern int ns_image_width (void *img); | |||
| 1200 | extern int ns_image_height (void *img); | 1202 | extern int ns_image_height (void *img); |
| 1201 | extern void ns_image_set_size (void *img, int width, int height); | 1203 | extern void ns_image_set_size (void *img, int width, int height); |
| 1202 | extern void ns_image_set_transform (void *img, double m[3][3]); | 1204 | extern void ns_image_set_transform (void *img, double m[3][3]); |
| 1205 | extern void ns_image_set_smoothing (void *img, bool smooth); | ||
| 1203 | extern unsigned long ns_get_pixel (void *img, int x, int y); | 1206 | extern unsigned long ns_get_pixel (void *img, int x, int y); |
| 1204 | extern void ns_put_pixel (void *img, int x, int y, unsigned long argb); | 1207 | extern void ns_put_pixel (void *img, int x, int y, unsigned long argb); |
| 1205 | extern void ns_set_alpha (void *img, int x, int y, unsigned char a); | 1208 | extern void ns_set_alpha (void *img, int x, int y, unsigned char a); |
diff --git a/src/nsterm.m b/src/nsterm.m index df7f716f51e..572b859a982 100644 --- a/src/nsterm.m +++ b/src/nsterm.m | |||
| @@ -4043,10 +4043,22 @@ ns_dumpglyphs_image (struct glyph_string *s, NSRect r) | |||
| 4043 | 4043 | ||
| 4044 | [doTransform concat]; | 4044 | [doTransform concat]; |
| 4045 | 4045 | ||
| 4046 | /* Smoothing is the default, so if we don't want smoothing we | ||
| 4047 | have to turn it off. */ | ||
| 4048 | if (! img->smoothing) | ||
| 4049 | [[NSGraphicsContext currentContext] | ||
| 4050 | setImageInterpolation:NSImageInterpolationNone]; | ||
| 4051 | |||
| 4046 | [img drawInRect:ir fromRect:ir | 4052 | [img drawInRect:ir fromRect:ir |
| 4047 | operation:NSCompositingOperationSourceOver | 4053 | operation:NSCompositingOperationSourceOver |
| 4048 | fraction:1.0 respectFlipped:YES hints:nil]; | 4054 | fraction:1.0 respectFlipped:YES hints:nil]; |
| 4049 | 4055 | ||
| 4056 | /* Apparently image interpolation is not reset with | ||
| 4057 | restoreGraphicsState, so we have to manually reset it. */ | ||
| 4058 | if (! img->smoothing) | ||
| 4059 | [[NSGraphicsContext currentContext] | ||
| 4060 | setImageInterpolation:NSImageInterpolationDefault]; | ||
| 4061 | |||
| 4050 | [[NSGraphicsContext currentContext] restoreGraphicsState]; | 4062 | [[NSGraphicsContext currentContext] restoreGraphicsState]; |
| 4051 | } | 4063 | } |
| 4052 | 4064 | ||
diff --git a/src/pdumper.c b/src/pdumper.c index 28529d63648..de9c06c9d2c 100644 --- a/src/pdumper.c +++ b/src/pdumper.c | |||
| @@ -4785,15 +4785,15 @@ dump_mmap_contiguous_heap (struct dump_memory_map *maps, int nr_maps, | |||
| 4785 | Beware: the simple patch 2019-03-11T15:20:54Z!eggert@cs.ucla.edu | 4785 | Beware: the simple patch 2019-03-11T15:20:54Z!eggert@cs.ucla.edu |
| 4786 | is worse, as it sometimes frees this storage twice. */ | 4786 | is worse, as it sometimes frees this storage twice. */ |
| 4787 | struct dump_memory_map_heap_control_block *cb = calloc (1, sizeof (*cb)); | 4787 | struct dump_memory_map_heap_control_block *cb = calloc (1, sizeof (*cb)); |
| 4788 | |||
| 4789 | char *mem; | ||
| 4790 | if (!cb) | 4788 | if (!cb) |
| 4791 | goto out; | 4789 | goto out; |
| 4790 | __lsan_ignore_object (cb); | ||
| 4791 | |||
| 4792 | cb->refcount = 1; | 4792 | cb->refcount = 1; |
| 4793 | cb->mem = malloc (total_size); | 4793 | cb->mem = malloc (total_size); |
| 4794 | if (!cb->mem) | 4794 | if (!cb->mem) |
| 4795 | goto out; | 4795 | goto out; |
| 4796 | mem = cb->mem; | 4796 | char *mem = cb->mem; |
| 4797 | for (int i = 0; i < nr_maps; ++i) | 4797 | for (int i = 0; i < nr_maps; ++i) |
| 4798 | { | 4798 | { |
| 4799 | struct dump_memory_map *map = &maps[i]; | 4799 | struct dump_memory_map *map = &maps[i]; |
diff --git a/src/process.c b/src/process.c index 6e5bcf307ab..15634e4a8b0 100644 --- a/src/process.c +++ b/src/process.c | |||
| @@ -5491,6 +5491,10 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, | |||
| 5491 | } | 5491 | } |
| 5492 | else | 5492 | else |
| 5493 | { | 5493 | { |
| 5494 | #ifdef HAVE_GNUTLS | ||
| 5495 | int tls_nfds; | ||
| 5496 | fd_set tls_available; | ||
| 5497 | #endif | ||
| 5494 | /* Set the timeout for adaptive read buffering if any | 5498 | /* Set the timeout for adaptive read buffering if any |
| 5495 | process has non-zero read_output_skip and non-zero | 5499 | process has non-zero read_output_skip and non-zero |
| 5496 | read_output_delay, and we are not reading output for a | 5500 | read_output_delay, and we are not reading output for a |
| @@ -5560,7 +5564,36 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, | |||
| 5560 | } | 5564 | } |
| 5561 | #endif | 5565 | #endif |
| 5562 | 5566 | ||
| 5563 | /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */ | 5567 | #ifdef HAVE_GNUTLS |
| 5568 | /* GnuTLS buffers data internally. We need to check if some | ||
| 5569 | data is available in the buffers manually before the select. | ||
| 5570 | And if so, we need to skip the select which could block. */ | ||
| 5571 | FD_ZERO (&tls_available); | ||
| 5572 | tls_nfds = 0; | ||
| 5573 | for (channel = 0; channel < FD_SETSIZE; ++channel) | ||
| 5574 | if (! NILP (chan_process[channel]) | ||
| 5575 | && FD_ISSET (channel, &Available)) | ||
| 5576 | { | ||
| 5577 | struct Lisp_Process *p = XPROCESS (chan_process[channel]); | ||
| 5578 | if (p | ||
| 5579 | && p->gnutls_p && p->gnutls_state | ||
| 5580 | && emacs_gnutls_record_check_pending (p->gnutls_state) > 0) | ||
| 5581 | { | ||
| 5582 | tls_nfds++; | ||
| 5583 | eassert (p->infd == channel); | ||
| 5584 | FD_SET (p->infd, &tls_available); | ||
| 5585 | } | ||
| 5586 | } | ||
| 5587 | /* If wait_proc is somebody else, we have to wait in select | ||
| 5588 | as usual. Otherwise, clobber the timeout. */ | ||
| 5589 | if (tls_nfds > 0 | ||
| 5590 | && (!wait_proc || | ||
| 5591 | (wait_proc->infd >= 0 | ||
| 5592 | && FD_ISSET (wait_proc->infd, &tls_available)))) | ||
| 5593 | timeout = make_timespec (0, 0); | ||
| 5594 | #endif | ||
| 5595 | |||
| 5596 | /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */ | ||
| 5564 | #if defined HAVE_GLIB && !defined HAVE_NS | 5597 | #if defined HAVE_GLIB && !defined HAVE_NS |
| 5565 | nfds = xg_select (max_desc + 1, | 5598 | nfds = xg_select (max_desc + 1, |
| 5566 | &Available, (check_write ? &Writeok : 0), | 5599 | &Available, (check_write ? &Writeok : 0), |
| @@ -5578,59 +5611,21 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd, | |||
| 5578 | #endif /* !HAVE_GLIB */ | 5611 | #endif /* !HAVE_GLIB */ |
| 5579 | 5612 | ||
| 5580 | #ifdef HAVE_GNUTLS | 5613 | #ifdef HAVE_GNUTLS |
| 5581 | /* GnuTLS buffers data internally. In lowat mode it leaves | 5614 | /* Merge tls_available into Available. */ |
| 5582 | some data in the TCP buffers so that select works, but | 5615 | if (tls_nfds > 0) |
| 5583 | with custom pull/push functions we need to check if some | ||
| 5584 | data is available in the buffers manually. */ | ||
| 5585 | if (nfds == 0) | ||
| 5586 | { | 5616 | { |
| 5587 | fd_set tls_available; | 5617 | if (nfds == 0 || (nfds < 0 && errno == EINTR)) |
| 5588 | int set = 0; | ||
| 5589 | |||
| 5590 | FD_ZERO (&tls_available); | ||
| 5591 | if (! wait_proc) | ||
| 5592 | { | 5618 | { |
| 5593 | /* We're not waiting on a specific process, so loop | 5619 | /* Fast path, just copy. */ |
| 5594 | through all the channels and check for data. | 5620 | nfds = tls_nfds; |
| 5595 | This is a workaround needed for some versions of | 5621 | Available = tls_available; |
| 5596 | the gnutls library -- 2.12.14 has been confirmed | ||
| 5597 | to need it. */ | ||
| 5598 | for (channel = 0; channel < FD_SETSIZE; ++channel) | ||
| 5599 | if (! NILP (chan_process[channel])) | ||
| 5600 | { | ||
| 5601 | struct Lisp_Process *p = | ||
| 5602 | XPROCESS (chan_process[channel]); | ||
| 5603 | if (p && p->gnutls_p && p->gnutls_state | ||
| 5604 | && ((emacs_gnutls_record_check_pending | ||
| 5605 | (p->gnutls_state)) | ||
| 5606 | > 0)) | ||
| 5607 | { | ||
| 5608 | nfds++; | ||
| 5609 | eassert (p->infd == channel); | ||
| 5610 | FD_SET (p->infd, &tls_available); | ||
| 5611 | set++; | ||
| 5612 | } | ||
| 5613 | } | ||
| 5614 | } | ||
| 5615 | else | ||
| 5616 | { | ||
| 5617 | /* Check this specific channel. */ | ||
| 5618 | if (wait_proc->gnutls_p /* Check for valid process. */ | ||
| 5619 | && wait_proc->gnutls_state | ||
| 5620 | /* Do we have pending data? */ | ||
| 5621 | && ((emacs_gnutls_record_check_pending | ||
| 5622 | (wait_proc->gnutls_state)) | ||
| 5623 | > 0)) | ||
| 5624 | { | ||
| 5625 | nfds = 1; | ||
| 5626 | eassert (0 <= wait_proc->infd); | ||
| 5627 | /* Set to Available. */ | ||
| 5628 | FD_SET (wait_proc->infd, &tls_available); | ||
| 5629 | set++; | ||
| 5630 | } | ||
| 5631 | } | 5622 | } |
| 5632 | if (set) | 5623 | else if (nfds > 0) |
| 5633 | Available = tls_available; | 5624 | /* Slow path, merge one by one. Note: nfds does not need |
| 5625 | to be accurate, just positive is enough. */ | ||
| 5626 | for (channel = 0; channel < FD_SETSIZE; ++channel) | ||
| 5627 | if (FD_ISSET(channel, &tls_available)) | ||
| 5628 | FD_SET(channel, &Available); | ||
| 5634 | } | 5629 | } |
| 5635 | #endif | 5630 | #endif |
| 5636 | } | 5631 | } |
diff --git a/src/ptr-bounds.h b/src/ptr-bounds.h deleted file mode 100644 index 22d49f25b6c..00000000000 --- a/src/ptr-bounds.h +++ /dev/null | |||
| @@ -1,79 +0,0 @@ | |||
| 1 | /* Pointer bounds checking for GNU Emacs | ||
| 2 | |||
| 3 | Copyright 2017-2020 Free Software Foundation, Inc. | ||
| 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 (at | ||
| 10 | 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 | /* Pointer bounds checking is a no-op unless running on hardware | ||
| 21 | supporting Intel MPX (Intel Skylake or better). Also, it requires | ||
| 22 | GCC 5 and Linux kernel 3.19, or later. Configure with | ||
| 23 | CFLAGS='-fcheck-pointer-bounds -mmpx', perhaps with | ||
| 24 | -fchkp-first-field-has-own-bounds thrown in. | ||
| 25 | |||
| 26 | Although pointer bounds checking can help during debugging, it is | ||
| 27 | disabled by default because it hurts performance significantly. | ||
| 28 | The checking does not detect all pointer errors. For example, a | ||
| 29 | dumped Emacs might not detect a bounds violation of a pointer that | ||
| 30 | was created before Emacs was dumped. */ | ||
| 31 | |||
| 32 | #ifndef PTR_BOUNDS_H | ||
| 33 | #define PTR_BOUNDS_H | ||
| 34 | |||
| 35 | #include <stddef.h> | ||
| 36 | |||
| 37 | /* When not checking pointer bounds, the following macros simply | ||
| 38 | return their first argument. These macros return either void *, or | ||
| 39 | the same type as their first argument. */ | ||
| 40 | |||
| 41 | INLINE_HEADER_BEGIN | ||
| 42 | |||
| 43 | /* Return a copy of P, with bounds narrowed to [P, P + N). */ | ||
| 44 | #ifdef __CHKP__ | ||
| 45 | INLINE void * | ||
| 46 | ptr_bounds_clip (void const *p, size_t n) | ||
| 47 | { | ||
| 48 | return __builtin___bnd_narrow_ptr_bounds (p, p, n); | ||
| 49 | } | ||
| 50 | #else | ||
| 51 | # define ptr_bounds_clip(p, n) ((void) (size_t) {n}, p) | ||
| 52 | #endif | ||
| 53 | |||
| 54 | /* Return a copy of P, but with the bounds of Q. */ | ||
| 55 | #ifdef __CHKP__ | ||
| 56 | # define ptr_bounds_copy(p, q) __builtin___bnd_copy_ptr_bounds (p, q) | ||
| 57 | #else | ||
| 58 | # define ptr_bounds_copy(p, q) ((void) (void const *) {q}, p) | ||
| 59 | #endif | ||
| 60 | |||
| 61 | /* Return a copy of P, but with infinite bounds. | ||
| 62 | This is a loophole in pointer bounds checking. */ | ||
| 63 | #ifdef __CHKP__ | ||
| 64 | # define ptr_bounds_init(p) __builtin___bnd_init_ptr_bounds (p) | ||
| 65 | #else | ||
| 66 | # define ptr_bounds_init(p) (p) | ||
| 67 | #endif | ||
| 68 | |||
| 69 | /* Return a copy of P, but with bounds [P, P + N). | ||
| 70 | This is a loophole in pointer bounds checking. */ | ||
| 71 | #ifdef __CHKP__ | ||
| 72 | # define ptr_bounds_set(p, n) __builtin___bnd_set_ptr_bounds (p, n) | ||
| 73 | #else | ||
| 74 | # define ptr_bounds_set(p, n) ((void) (size_t) {n}, p) | ||
| 75 | #endif | ||
| 76 | |||
| 77 | INLINE_HEADER_END | ||
| 78 | |||
| 79 | #endif /* PTR_BOUNDS_H */ | ||
diff --git a/src/regex-emacs.c b/src/regex-emacs.c index 1ecbc74b96c..c44cce9f787 100644 --- a/src/regex-emacs.c +++ b/src/regex-emacs.c | |||
| @@ -29,10 +29,6 @@ | |||
| 29 | 29 | ||
| 30 | #include <stdlib.h> | 30 | #include <stdlib.h> |
| 31 | 31 | ||
| 32 | #ifdef HAVE_SANITIZER_LSAN_INTERFACE_H | ||
| 33 | #include <sanitizer/lsan_interface.h> | ||
| 34 | #endif | ||
| 35 | |||
| 36 | #include "character.h" | 32 | #include "character.h" |
| 37 | #include "buffer.h" | 33 | #include "buffer.h" |
| 38 | #include "syntax.h" | 34 | #include "syntax.h" |
| @@ -1761,9 +1757,7 @@ regex_compile (re_char *pattern, ptrdiff_t size, | |||
| 1761 | /* Initialize the compile stack. */ | 1757 | /* Initialize the compile stack. */ |
| 1762 | compile_stack.stack = xmalloc (INIT_COMPILE_STACK_SIZE | 1758 | compile_stack.stack = xmalloc (INIT_COMPILE_STACK_SIZE |
| 1763 | * sizeof *compile_stack.stack); | 1759 | * sizeof *compile_stack.stack); |
| 1764 | #ifdef HAVE___LSAN_IGNORE_OBJECT | ||
| 1765 | __lsan_ignore_object (compile_stack.stack); | 1760 | __lsan_ignore_object (compile_stack.stack); |
| 1766 | #endif | ||
| 1767 | compile_stack.size = INIT_COMPILE_STACK_SIZE; | 1761 | compile_stack.size = INIT_COMPILE_STACK_SIZE; |
| 1768 | compile_stack.avail = 0; | 1762 | compile_stack.avail = 0; |
| 1769 | 1763 | ||
diff --git a/src/search.c b/src/search.c index 7b74ff91480..38c64caf7c0 100644 --- a/src/search.c +++ b/src/search.c | |||
| @@ -21,10 +21,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ | |||
| 21 | 21 | ||
| 22 | #include <config.h> | 22 | #include <config.h> |
| 23 | 23 | ||
| 24 | #ifdef HAVE_SANITIZER_LSAN_INTERFACE_H | ||
| 25 | #include <sanitizer/lsan_interface.h> | ||
| 26 | #endif | ||
| 27 | |||
| 28 | #include "lisp.h" | 24 | #include "lisp.h" |
| 29 | #include "character.h" | 25 | #include "character.h" |
| 30 | #include "buffer.h" | 26 | #include "buffer.h" |
| @@ -619,9 +615,7 @@ newline_cache_on_off (struct buffer *buf) | |||
| 619 | if (base_buf->newline_cache == 0) | 615 | if (base_buf->newline_cache == 0) |
| 620 | { | 616 | { |
| 621 | base_buf->newline_cache = new_region_cache (); | 617 | base_buf->newline_cache = new_region_cache (); |
| 622 | #ifdef HAVE___LSAN_IGNORE_OBJECT | ||
| 623 | __lsan_ignore_object (base_buf->newline_cache); | 618 | __lsan_ignore_object (base_buf->newline_cache); |
| 624 | #endif | ||
| 625 | } | 619 | } |
| 626 | } | 620 | } |
| 627 | return base_buf->newline_cache; | 621 | return base_buf->newline_cache; |
diff --git a/src/xdisp.c b/src/xdisp.c index fc17014c029..4fe1c4288af 100644 --- a/src/xdisp.c +++ b/src/xdisp.c | |||
| @@ -993,12 +993,12 @@ static void handle_line_prefix (struct it *); | |||
| 993 | static void handle_stop_backwards (struct it *, ptrdiff_t); | 993 | static void handle_stop_backwards (struct it *, ptrdiff_t); |
| 994 | static void unwind_with_echo_area_buffer (Lisp_Object); | 994 | static void unwind_with_echo_area_buffer (Lisp_Object); |
| 995 | static Lisp_Object with_echo_area_buffer_unwind_data (struct window *); | 995 | static Lisp_Object with_echo_area_buffer_unwind_data (struct window *); |
| 996 | static bool current_message_1 (ptrdiff_t, Lisp_Object); | 996 | static bool current_message_1 (void *, Lisp_Object); |
| 997 | static bool truncate_message_1 (ptrdiff_t, Lisp_Object); | 997 | static bool truncate_message_1 (void *, Lisp_Object); |
| 998 | static void set_message (Lisp_Object); | 998 | static void set_message (Lisp_Object); |
| 999 | static bool set_message_1 (ptrdiff_t, Lisp_Object); | 999 | static bool set_message_1 (void *, Lisp_Object); |
| 1000 | static bool display_echo_area_1 (ptrdiff_t, Lisp_Object); | 1000 | static bool display_echo_area_1 (void *, Lisp_Object); |
| 1001 | static bool resize_mini_window_1 (ptrdiff_t, Lisp_Object); | 1001 | static bool resize_mini_window_1 (void *, Lisp_Object); |
| 1002 | static void unwind_redisplay (void); | 1002 | static void unwind_redisplay (void); |
| 1003 | static void extend_face_to_end_of_line (struct it *); | 1003 | static void extend_face_to_end_of_line (struct it *); |
| 1004 | static intmax_t message_log_check_duplicate (ptrdiff_t, ptrdiff_t); | 1004 | static intmax_t message_log_check_duplicate (ptrdiff_t, ptrdiff_t); |
| @@ -11278,8 +11278,8 @@ ensure_echo_area_buffers (void) | |||
| 11278 | 11278 | ||
| 11279 | static bool | 11279 | static bool |
| 11280 | with_echo_area_buffer (struct window *w, int which, | 11280 | with_echo_area_buffer (struct window *w, int which, |
| 11281 | bool (*fn) (ptrdiff_t, Lisp_Object), | 11281 | bool (*fn) (void *, Lisp_Object), |
| 11282 | ptrdiff_t a1, Lisp_Object a2) | 11282 | void *a1, Lisp_Object a2) |
| 11283 | { | 11283 | { |
| 11284 | Lisp_Object buffer; | 11284 | Lisp_Object buffer; |
| 11285 | bool this_one, the_other, clear_buffer_p, rc; | 11285 | bool this_one, the_other, clear_buffer_p, rc; |
| @@ -11550,8 +11550,7 @@ display_echo_area (struct window *w) | |||
| 11550 | 11550 | ||
| 11551 | window_height_changed_p | 11551 | window_height_changed_p |
| 11552 | = with_echo_area_buffer (w, display_last_displayed_message_p, | 11552 | = with_echo_area_buffer (w, display_last_displayed_message_p, |
| 11553 | display_echo_area_1, | 11553 | display_echo_area_1, w, Qnil); |
| 11554 | (intptr_t) w, Qnil); | ||
| 11555 | 11554 | ||
| 11556 | if (no_message_p) | 11555 | if (no_message_p) |
| 11557 | echo_area_buffer[i] = Qnil; | 11556 | echo_area_buffer[i] = Qnil; |
| @@ -11568,10 +11567,9 @@ display_echo_area (struct window *w) | |||
| 11568 | Value is true if height of W was changed. */ | 11567 | Value is true if height of W was changed. */ |
| 11569 | 11568 | ||
| 11570 | static bool | 11569 | static bool |
| 11571 | display_echo_area_1 (ptrdiff_t a1, Lisp_Object a2) | 11570 | display_echo_area_1 (void *a1, Lisp_Object a2) |
| 11572 | { | 11571 | { |
| 11573 | intptr_t i1 = a1; | 11572 | struct window *w = a1; |
| 11574 | struct window *w = (struct window *) i1; | ||
| 11575 | Lisp_Object window; | 11573 | Lisp_Object window; |
| 11576 | struct text_pos start; | 11574 | struct text_pos start; |
| 11577 | 11575 | ||
| @@ -11612,7 +11610,7 @@ resize_echo_area_exactly (void) | |||
| 11612 | struct window *w = XWINDOW (echo_area_window); | 11610 | struct window *w = XWINDOW (echo_area_window); |
| 11613 | Lisp_Object resize_exactly = (minibuf_level == 0 ? Qt : Qnil); | 11611 | Lisp_Object resize_exactly = (minibuf_level == 0 ? Qt : Qnil); |
| 11614 | bool resized_p = with_echo_area_buffer (w, 0, resize_mini_window_1, | 11612 | bool resized_p = with_echo_area_buffer (w, 0, resize_mini_window_1, |
| 11615 | (intptr_t) w, resize_exactly); | 11613 | w, resize_exactly); |
| 11616 | if (resized_p) | 11614 | if (resized_p) |
| 11617 | { | 11615 | { |
| 11618 | windows_or_buffers_changed = 42; | 11616 | windows_or_buffers_changed = 42; |
| @@ -11630,10 +11628,9 @@ resize_echo_area_exactly (void) | |||
| 11630 | returns. */ | 11628 | returns. */ |
| 11631 | 11629 | ||
| 11632 | static bool | 11630 | static bool |
| 11633 | resize_mini_window_1 (ptrdiff_t a1, Lisp_Object exactly) | 11631 | resize_mini_window_1 (void *a1, Lisp_Object exactly) |
| 11634 | { | 11632 | { |
| 11635 | intptr_t i1 = a1; | 11633 | return resize_mini_window (a1, !NILP (exactly)); |
| 11636 | return resize_mini_window ((struct window *) i1, !NILP (exactly)); | ||
| 11637 | } | 11634 | } |
| 11638 | 11635 | ||
| 11639 | 11636 | ||
| @@ -11769,8 +11766,7 @@ current_message (void) | |||
| 11769 | msg = Qnil; | 11766 | msg = Qnil; |
| 11770 | else | 11767 | else |
| 11771 | { | 11768 | { |
| 11772 | with_echo_area_buffer (0, 0, current_message_1, | 11769 | with_echo_area_buffer (0, 0, current_message_1, &msg, Qnil); |
| 11773 | (intptr_t) &msg, Qnil); | ||
| 11774 | if (NILP (msg)) | 11770 | if (NILP (msg)) |
| 11775 | echo_area_buffer[0] = Qnil; | 11771 | echo_area_buffer[0] = Qnil; |
| 11776 | } | 11772 | } |
| @@ -11780,10 +11776,9 @@ current_message (void) | |||
| 11780 | 11776 | ||
| 11781 | 11777 | ||
| 11782 | static bool | 11778 | static bool |
| 11783 | current_message_1 (ptrdiff_t a1, Lisp_Object a2) | 11779 | current_message_1 (void *a1, Lisp_Object a2) |
| 11784 | { | 11780 | { |
| 11785 | intptr_t i1 = a1; | 11781 | Lisp_Object *msg = a1; |
| 11786 | Lisp_Object *msg = (Lisp_Object *) i1; | ||
| 11787 | 11782 | ||
| 11788 | if (Z > BEG) | 11783 | if (Z > BEG) |
| 11789 | *msg = make_buffer_string (BEG, Z, true); | 11784 | *msg = make_buffer_string (BEG, Z, true); |
| @@ -11857,7 +11852,8 @@ truncate_echo_area (ptrdiff_t nchars) | |||
| 11857 | just an informative message; if the frame hasn't really been | 11852 | just an informative message; if the frame hasn't really been |
| 11858 | initialized yet, just toss it. */ | 11853 | initialized yet, just toss it. */ |
| 11859 | if (sf->glyphs_initialized_p) | 11854 | if (sf->glyphs_initialized_p) |
| 11860 | with_echo_area_buffer (0, 0, truncate_message_1, nchars, Qnil); | 11855 | with_echo_area_buffer (0, 0, truncate_message_1, |
| 11856 | (void *) (intptr_t) nchars, Qnil); | ||
| 11861 | } | 11857 | } |
| 11862 | } | 11858 | } |
| 11863 | 11859 | ||
| @@ -11866,8 +11862,9 @@ truncate_echo_area (ptrdiff_t nchars) | |||
| 11866 | message to at most NCHARS characters. */ | 11862 | message to at most NCHARS characters. */ |
| 11867 | 11863 | ||
| 11868 | static bool | 11864 | static bool |
| 11869 | truncate_message_1 (ptrdiff_t nchars, Lisp_Object a2) | 11865 | truncate_message_1 (void *a1, Lisp_Object a2) |
| 11870 | { | 11866 | { |
| 11867 | intptr_t nchars = (intptr_t) a1; | ||
| 11871 | if (BEG + nchars < Z) | 11868 | if (BEG + nchars < Z) |
| 11872 | del_range (BEG + nchars, Z); | 11869 | del_range (BEG + nchars, Z); |
| 11873 | if (Z == BEG) | 11870 | if (Z == BEG) |
| @@ -11919,7 +11916,7 @@ set_message (Lisp_Object string) | |||
| 11919 | This function is called with the echo area buffer being current. */ | 11916 | This function is called with the echo area buffer being current. */ |
| 11920 | 11917 | ||
| 11921 | static bool | 11918 | static bool |
| 11922 | set_message_1 (ptrdiff_t a1, Lisp_Object string) | 11919 | set_message_1 (void *a1, Lisp_Object string) |
| 11923 | { | 11920 | { |
| 11924 | eassert (STRINGP (string)); | 11921 | eassert (STRINGP (string)); |
| 11925 | 11922 | ||
| @@ -19223,18 +19220,19 @@ try_window (Lisp_Object window, struct text_pos pos, int flags) | |||
| 19223 | && !MINI_WINDOW_P (w)) | 19220 | && !MINI_WINDOW_P (w)) |
| 19224 | { | 19221 | { |
| 19225 | int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); | 19222 | int this_scroll_margin = window_scroll_margin (w, MARGIN_IN_PIXELS); |
| 19223 | if (window_wants_header_line (w)) | ||
| 19224 | this_scroll_margin += CURRENT_HEADER_LINE_HEIGHT (w); | ||
| 19226 | start_display (&it, w, pos); | 19225 | start_display (&it, w, pos); |
| 19227 | 19226 | ||
| 19228 | if ((w->cursor.y >= 0 /* not vscrolled */ | 19227 | if ((w->cursor.y >= 0 /* not vscrolled */ |
| 19229 | && w->cursor.y < this_scroll_margin | 19228 | && w->cursor.y < this_scroll_margin |
| 19230 | && CHARPOS (pos) > BEGV | 19229 | && CHARPOS (pos) > BEGV) |
| 19231 | && it_charpos < ZV) | ||
| 19232 | /* rms: considering make_cursor_line_fully_visible_p here | 19230 | /* rms: considering make_cursor_line_fully_visible_p here |
| 19233 | seems to give wrong results. We don't want to recenter | 19231 | seems to give wrong results. We don't want to recenter |
| 19234 | when the last line is partly visible, we want to allow | 19232 | when the last line is partly visible, we want to allow |
| 19235 | that case to be handled in the usual way. */ | 19233 | that case to be handled in the usual way. */ |
| 19236 | || w->cursor.y > (it.last_visible_y - partial_line_height (&it) | 19234 | || w->cursor.y > (it.last_visible_y - partial_line_height (&it) |
| 19237 | - this_scroll_margin - 1)) | 19235 | - this_scroll_margin - 1)) |
| 19238 | { | 19236 | { |
| 19239 | w->cursor.vpos = -1; | 19237 | w->cursor.vpos = -1; |
| 19240 | clear_glyph_matrix (w->desired_matrix); | 19238 | clear_glyph_matrix (w->desired_matrix); |
diff --git a/src/xfns.c b/src/xfns.c index 2ab5080d977..09dcbbfb92d 100644 --- a/src/xfns.c +++ b/src/xfns.c | |||
| @@ -2652,7 +2652,7 @@ create_frame_xic (struct frame *f) | |||
| 2652 | goto out; | 2652 | goto out; |
| 2653 | 2653 | ||
| 2654 | xim = FRAME_X_XIM (f); | 2654 | xim = FRAME_X_XIM (f); |
| 2655 | if (!xim) | 2655 | if (!xim || ! FRAME_X_XIM_STYLES(f)) |
| 2656 | goto out; | 2656 | goto out; |
| 2657 | 2657 | ||
| 2658 | /* Determine XIC style. */ | 2658 | /* Determine XIC style. */ |
diff --git a/test/README b/test/README index 1f69f7142c1..fe05b5403b1 100644 --- a/test/README +++ b/test/README | |||
| @@ -64,6 +64,11 @@ protect against "make" variable expansion): | |||
| 64 | 64 | ||
| 65 | make <filename> SELECTOR='"foo$$"' | 65 | make <filename> SELECTOR='"foo$$"' |
| 66 | 66 | ||
| 67 | In case you want to use the symbol name of a test as selector, you can | ||
| 68 | use it directly: | ||
| 69 | |||
| 70 | make <filename> SELECTOR='test-foo-remote' | ||
| 71 | |||
| 67 | Note that although the test files are always compiled (unless they set | 72 | Note that although the test files are always compiled (unless they set |
| 68 | no-byte-compile), the source files will be run when expensive or | 73 | no-byte-compile), the source files will be run when expensive or |
| 69 | unstable tests are involved, to give nicer backtraces. To run the | 74 | unstable tests are involved, to give nicer backtraces. To run the |
diff --git a/test/data/mml-sec/.gpg-v21-migrated b/test/data/mml-sec/.gpg-v21-migrated new file mode 100644 index 00000000000..e69de29bb2d --- /dev/null +++ b/test/data/mml-sec/.gpg-v21-migrated | |||
diff --git a/test/data/mml-sec/gpg-agent.conf b/test/data/mml-sec/gpg-agent.conf new file mode 100644 index 00000000000..20192990caf --- /dev/null +++ b/test/data/mml-sec/gpg-agent.conf | |||
| @@ -0,0 +1,5 @@ | |||
| 1 | # pinentry-program /usr/bin/pinentry-gtk-2 | ||
| 2 | |||
| 3 | # verbose | ||
| 4 | # log-file /tmp/gpg-agent.log | ||
| 5 | # debug-all | ||
diff --git a/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key b/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key new file mode 100644 index 00000000000..58fd0b5edbc --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key b/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key new file mode 100644 index 00000000000..62f4ab25a69 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key b/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key new file mode 100644 index 00000000000..2a8ce135fb2 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key b/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key new file mode 100644 index 00000000000..9f8de71c5e2 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key b/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key new file mode 100644 index 00000000000..6e4a4e548fd --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key b/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key new file mode 100644 index 00000000000..cff58edaa89 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key b/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key new file mode 100644 index 00000000000..14af8662f79 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key b/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key new file mode 100644 index 00000000000..207a7237d3a --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key b/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key new file mode 100644 index 00000000000..85ca78da04d --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key b/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key new file mode 100644 index 00000000000..79f3cd2b841 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key b/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key new file mode 100644 index 00000000000..776ddf7e9e2 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key b/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key new file mode 100644 index 00000000000..2b464f0ccbe --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key b/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key new file mode 100644 index 00000000000..28a07668b21 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key b/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key new file mode 100644 index 00000000000..137659693bd --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key b/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key new file mode 100644 index 00000000000..c99824ccd43 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key b/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key new file mode 100644 index 00000000000..49c2dc58bd8 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key b/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key new file mode 100644 index 00000000000..ca128408952 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key b/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key new file mode 100644 index 00000000000..3f14b40927a --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key b/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key new file mode 100644 index 00000000000..06adc06c427 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key b/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key new file mode 100644 index 00000000000..cf9a60d233b --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key b/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key new file mode 100644 index 00000000000..0ed35172fe0 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key b/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key new file mode 100644 index 00000000000..090059d9e81 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key b/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key new file mode 100644 index 00000000000..9061f675121 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key b/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key new file mode 100644 index 00000000000..89f6013100d --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key b/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key new file mode 100644 index 00000000000..41dac37574e --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key b/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key new file mode 100644 index 00000000000..5df7b4a5953 --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key b/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key new file mode 100644 index 00000000000..03daf80975b --- /dev/null +++ b/test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.key | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/pubring.gpg b/test/data/mml-sec/pubring.gpg new file mode 100644 index 00000000000..6bd169963df --- /dev/null +++ b/test/data/mml-sec/pubring.gpg | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/pubring.kbx b/test/data/mml-sec/pubring.kbx new file mode 100644 index 00000000000..399a0414fd2 --- /dev/null +++ b/test/data/mml-sec/pubring.kbx | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/secring.gpg b/test/data/mml-sec/secring.gpg new file mode 100644 index 00000000000..b323c072c04 --- /dev/null +++ b/test/data/mml-sec/secring.gpg | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/trustdb.gpg b/test/data/mml-sec/trustdb.gpg new file mode 100644 index 00000000000..09ebd8db114 --- /dev/null +++ b/test/data/mml-sec/trustdb.gpg | |||
| Binary files differ | |||
diff --git a/test/data/mml-sec/trustlist.txt b/test/data/mml-sec/trustlist.txt new file mode 100644 index 00000000000..f886572d283 --- /dev/null +++ b/test/data/mml-sec/trustlist.txt | |||
| @@ -0,0 +1,26 @@ | |||
| 1 | # This is the list of trusted keys. Comment lines, like this one, as | ||
| 2 | # well as empty lines are ignored. Lines have a length limit but this | ||
| 3 | # is not a serious limitation as the format of the entries is fixed and | ||
| 4 | # checked by gpg-agent. A non-comment line starts with optional white | ||
| 5 | # space, followed by the SHA-1 fingerpint in hex, followed by a flag | ||
| 6 | # which may be one of 'P', 'S' or '*' and optionally followed by a list of | ||
| 7 | # other flags. The fingerprint may be prefixed with a '!' to mark the | ||
| 8 | # key as not trusted. You should give the gpg-agent a HUP or run the | ||
| 9 | # command "gpgconf --reload gpg-agent" after changing this file. | ||
| 10 | |||
| 11 | |||
| 12 | # Include the default trust list | ||
| 13 | include-default | ||
| 14 | |||
| 15 | |||
| 16 | # CN=No Expiry | ||
| 17 | D0:6A:A1:18:65:3C:C3:8E:9D:0C:AF:56:ED:7A:21:35:E1:58:21:77 S relax | ||
| 18 | |||
| 19 | # CN=Second Key Pair | ||
| 20 | 0E:58:22:9B:80:EE:33:95:9F:F7:18:FE:EF:25:40:2B:47:9D:C6:E2 S relax | ||
| 21 | |||
| 22 | # CN=No Expiry two UIDs | ||
| 23 | D4:CA:78:E1:47:0B:9F:C2:AE:45:D7:84:64:9B:8C:E6:4E:BB:32:0C S relax | ||
| 24 | |||
| 25 | # CN=Different subkeys | ||
| 26 | 4F:96:2A:B7:F4:76:61:6A:78:3D:72:AA:40:35:D5:9B:5F:88:E9:FC S relax | ||
diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index 3eecc67eb53..fe1460cf29e 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el | |||
| @@ -109,4 +109,18 @@ | |||
| 109 | (ert-deftest test-time-since () | 109 | (ert-deftest test-time-since () |
| 110 | (should (time-equal-p 0 (time-since nil)))) | 110 | (should (time-equal-p 0 (time-since nil)))) |
| 111 | 111 | ||
| 112 | (ert-deftest test-time-decoded-period () | ||
| 113 | (should (equal (decoded-time-period '(nil nil 1 nil nil nil nil nil nil)) | ||
| 114 | 3600)) | ||
| 115 | |||
| 116 | (should (equal (decoded-time-period '(1 0 0 0 0 0 nil nil nil)) 1)) | ||
| 117 | (should (equal (decoded-time-period '(0 1 0 0 0 0 nil nil nil)) 60)) | ||
| 118 | (should (equal (decoded-time-period '(0 0 1 0 0 0 nil nil nil)) 3600)) | ||
| 119 | (should (equal (decoded-time-period '(0 0 0 1 0 0 nil nil nil)) 86400)) | ||
| 120 | (should (equal (decoded-time-period '(0 0 0 0 1 0 nil nil nil)) 2592000)) | ||
| 121 | (should (equal (decoded-time-period '(0 0 0 0 0 1 nil nil nil)) 31536000)) | ||
| 122 | |||
| 123 | (should (equal (decoded-time-period '((135 . 10) 0 0 0 0 0 nil nil nil)) | ||
| 124 | 13.5))) | ||
| 125 | |||
| 112 | ;;; time-date-tests.el ends here | 126 | ;;; time-date-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index c235dd43fcc..894914300ae 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el | |||
| @@ -47,6 +47,11 @@ | |||
| 47 | (let ((a 1.0)) (/ 3 a 2)) | 47 | (let ((a 1.0)) (/ 3 a 2)) |
| 48 | (let ((a most-positive-fixnum) (b 2.0)) (* a 2 b)) | 48 | (let ((a most-positive-fixnum) (b 2.0)) (* a 2 b)) |
| 49 | (let ((a 3) (b 2)) (/ a b 1.0)) | 49 | (let ((a 3) (b 2)) (/ a b 1.0)) |
| 50 | (let ((a -0.0)) (+ a)) | ||
| 51 | (let ((a -0.0)) (- a)) | ||
| 52 | (let ((a -0.0)) (* a)) | ||
| 53 | (let ((a -0.0)) (min a)) | ||
| 54 | (let ((a -0.0)) (max a)) | ||
| 50 | (/ 3 -1) | 55 | (/ 3 -1) |
| 51 | (+ 4 3 2 1) | 56 | (+ 4 3 2 1) |
| 52 | (+ 4 3 2.0 1) | 57 | (+ 4 3 2.0 1) |
diff --git a/test/lisp/emacs-lisp/cconv-tests.el b/test/lisp/emacs-lisp/cconv-tests.el index c8d46541ad4..0ea9742be49 100644 --- a/test/lisp/emacs-lisp/cconv-tests.el +++ b/test/lisp/emacs-lisp/cconv-tests.el | |||
| @@ -20,6 +20,166 @@ | |||
| 20 | ;;; Commentary: | 20 | ;;; Commentary: |
| 21 | 21 | ||
| 22 | (require 'ert) | 22 | (require 'ert) |
| 23 | (require 'cl-lib) | ||
| 24 | |||
| 25 | (ert-deftest cconv-tests-lambda-:documentation () | ||
| 26 | "Docstring for lambda can be specified with :documentation." | ||
| 27 | (let ((fun (lambda () | ||
| 28 | (:documentation (concat "lambda" " documentation")) | ||
| 29 | 'lambda-result))) | ||
| 30 | (should (string= (documentation fun) "lambda documentation")) | ||
| 31 | (should (eq (funcall fun) 'lambda-result)))) | ||
| 32 | |||
| 33 | (ert-deftest cconv-tests-pcase-lambda-:documentation () | ||
| 34 | "Docstring for pcase-lambda can be specified with :documentation." | ||
| 35 | (let ((fun (pcase-lambda (`(,a ,b)) | ||
| 36 | (:documentation (concat "pcase-lambda" " documentation")) | ||
| 37 | (list b a)))) | ||
| 38 | (should (string= (documentation fun) "pcase-lambda documentation")) | ||
| 39 | (should (equal '(2 1) (funcall fun '(1 2)))))) | ||
| 40 | |||
| 41 | (defun cconv-tests-defun () | ||
| 42 | (:documentation (concat "defun" " documentation")) | ||
| 43 | 'defun-result) | ||
| 44 | (ert-deftest cconv-tests-defun-:documentation () | ||
| 45 | "Docstring for defun can be specified with :documentation." | ||
| 46 | (should (string= (documentation 'cconv-tests-defun) | ||
| 47 | "defun documentation")) | ||
| 48 | (should (eq (cconv-tests-defun) 'defun-result))) | ||
| 49 | |||
| 50 | (cl-defun cconv-tests-cl-defun () | ||
| 51 | (:documentation (concat "cl-defun" " documentation")) | ||
| 52 | 'cl-defun-result) | ||
| 53 | (ert-deftest cconv-tests-cl-defun-:documentation () | ||
| 54 | "Docstring for cl-defun can be specified with :documentation." | ||
| 55 | (should (string= (documentation 'cconv-tests-cl-defun) | ||
| 56 | "cl-defun documentation")) | ||
| 57 | (should (eq (cconv-tests-cl-defun) 'cl-defun-result))) | ||
| 58 | |||
| 59 | ;; FIXME: The byte-complier croaks on this. See Bug#28557. | ||
| 60 | ;; (defmacro cconv-tests-defmacro () | ||
| 61 | ;; (:documentation (concat "defmacro" " documentation")) | ||
| 62 | ;; '(quote defmacro-result)) | ||
| 63 | ;; (ert-deftest cconv-tests-defmacro-:documentation () | ||
| 64 | ;; "Docstring for defmacro can be specified with :documentation." | ||
| 65 | ;; (should (string= (documentation 'cconv-tests-defmacro) | ||
| 66 | ;; "defmacro documentation")) | ||
| 67 | ;; (should (eq (cconv-tests-defmacro) 'defmacro-result))) | ||
| 68 | |||
| 69 | ;; FIXME: The byte-complier croaks on this. See Bug#28557. | ||
| 70 | ;; (cl-defmacro cconv-tests-cl-defmacro () | ||
| 71 | ;; (:documentation (concat "cl-defmacro" " documentation")) | ||
| 72 | ;; '(quote cl-defmacro-result)) | ||
| 73 | ;; (ert-deftest cconv-tests-cl-defmacro-:documentation () | ||
| 74 | ;; "Docstring for cl-defmacro can be specified with :documentation." | ||
| 75 | ;; (should (string= (documentation 'cconv-tests-cl-defmacro) | ||
| 76 | ;; "cl-defmacro documentation")) | ||
| 77 | ;; (should (eq (cconv-tests-cl-defmacro) 'cl-defmacro-result))) | ||
| 78 | |||
| 79 | (cl-iter-defun cconv-tests-cl-iter-defun () | ||
| 80 | (:documentation (concat "cl-iter-defun" " documentation")) | ||
| 81 | (iter-yield 'cl-iter-defun-result)) | ||
| 82 | (ert-deftest cconv-tests-cl-iter-defun-:documentation () | ||
| 83 | "Docstring for cl-iter-defun can be specified with :documentation." | ||
| 84 | ;; FIXME: See Bug#28557. | ||
| 85 | :tags '(:unstable) | ||
| 86 | :expected-result :failed | ||
| 87 | (should (string= (documentation 'cconv-tests-cl-iter-defun) | ||
| 88 | "cl-iter-defun documentation")) | ||
| 89 | (should (eq (iter-next (cconv-tests-cl-iter-defun)) | ||
| 90 | 'cl-iter-defun-result))) | ||
| 91 | |||
| 92 | (iter-defun cconv-tests-iter-defun () | ||
| 93 | (:documentation (concat "iter-defun" " documentation")) | ||
| 94 | (iter-yield 'iter-defun-result)) | ||
| 95 | (ert-deftest cconv-tests-iter-defun-:documentation () | ||
| 96 | "Docstring for iter-defun can be specified with :documentation." | ||
| 97 | ;; FIXME: See Bug#28557. | ||
| 98 | :tags '(:unstable) | ||
| 99 | :expected-result :failed | ||
| 100 | (should (string= (documentation 'cconv-tests-iter-defun) | ||
| 101 | "iter-defun documentation")) | ||
| 102 | (should (eq (iter-next (cconv-tests-iter-defun)) 'iter-defun-result))) | ||
| 103 | |||
| 104 | (ert-deftest cconv-tests-iter-lambda-:documentation () | ||
| 105 | "Docstring for iter-lambda can be specified with :documentation." | ||
| 106 | ;; FIXME: See Bug#28557. | ||
| 107 | :expected-result :failed | ||
| 108 | (let ((iter-fun | ||
| 109 | (iter-lambda () | ||
| 110 | (:documentation (concat "iter-lambda" " documentation")) | ||
| 111 | (iter-yield 'iter-lambda-result)))) | ||
| 112 | (should (string= (documentation iter-fun) "iter-lambda documentation")) | ||
| 113 | (should (eq (iter-next (funcall iter-fun)) 'iter-lambda-result)))) | ||
| 114 | |||
| 115 | (ert-deftest cconv-tests-cl-function-:documentation () | ||
| 116 | "Docstring for cl-function can be specified with :documentation." | ||
| 117 | ;; FIXME: See Bug#28557. | ||
| 118 | :expected-result :failed | ||
| 119 | (let ((fun (cl-function (lambda (&key arg) | ||
| 120 | (:documentation (concat "cl-function" | ||
| 121 | " documentation")) | ||
| 122 | (list arg 'cl-function-result))))) | ||
| 123 | (should (string= (documentation fun) "cl-function documentation")) | ||
| 124 | (should (equal (funcall fun :arg t) '(t cl-function-result))))) | ||
| 125 | |||
| 126 | (ert-deftest cconv-tests-function-:documentation () | ||
| 127 | "Docstring for lambda inside function can be specified with :documentation." | ||
| 128 | (let ((fun #'(lambda (arg) | ||
| 129 | (:documentation (concat "function" " documentation")) | ||
| 130 | (list arg 'function-result)))) | ||
| 131 | (should (string= (documentation fun) "function documentation")) | ||
| 132 | (should (equal (funcall fun t) '(t function-result))))) | ||
| 133 | |||
| 134 | (fmakunbound 'cconv-tests-cl-defgeneric) | ||
| 135 | (setplist 'cconv-tests-cl-defgeneric nil) | ||
| 136 | (cl-defgeneric cconv-tests-cl-defgeneric (n) | ||
| 137 | (:documentation (concat "cl-defgeneric" " documentation"))) | ||
| 138 | (cl-defmethod cconv-tests-cl-defgeneric ((n integer)) | ||
| 139 | (:documentation (concat "cl-defmethod" " documentation")) | ||
| 140 | (+ 1 n)) | ||
| 141 | (ert-deftest cconv-tests-cl-defgeneric-:documentation () | ||
| 142 | "Docstring for cl-defgeneric can be specified with :documentation." | ||
| 143 | ;; FIXME: See Bug#28557. | ||
| 144 | :expected-result :failed | ||
| 145 | (let ((descr (describe-function 'cconv-tests-cl-defgeneric))) | ||
| 146 | (set-text-properties 0 (length descr) nil descr) | ||
| 147 | (should (string-match-p "cl-defgeneric documentation" descr)) | ||
| 148 | (should (string-match-p "cl-defmethod documentation" descr))) | ||
| 149 | (should (= 11 (cconv-tests-cl-defgeneric 10)))) | ||
| 150 | |||
| 151 | (fmakunbound 'cconv-tests-cl-defgeneric-literal) | ||
| 152 | (setplist 'cconv-tests-cl-defgeneric-literal nil) | ||
| 153 | (cl-defgeneric cconv-tests-cl-defgeneric-literal (n) | ||
| 154 | (:documentation "cl-defgeneric-literal documentation")) | ||
| 155 | (cl-defmethod cconv-tests-cl-defgeneric-literal ((n integer)) | ||
| 156 | (:documentation "cl-defmethod-literal documentation") | ||
| 157 | (+ 1 n)) | ||
| 158 | (ert-deftest cconv-tests-cl-defgeneric-literal-:documentation () | ||
| 159 | "Docstring for cl-defgeneric can be specified with :documentation." | ||
| 160 | (let ((descr (describe-function 'cconv-tests-cl-defgeneric-literal))) | ||
| 161 | (set-text-properties 0 (length descr) nil descr) | ||
| 162 | (should (string-match-p "cl-defgeneric-literal documentation" descr)) | ||
| 163 | (should (string-match-p "cl-defmethod-literal documentation" descr))) | ||
| 164 | (should (= 11 (cconv-tests-cl-defgeneric-literal 10)))) | ||
| 165 | |||
| 166 | (defsubst cconv-tests-defsubst () | ||
| 167 | (:documentation (concat "defsubst" " documentation")) | ||
| 168 | 'defsubst-result) | ||
| 169 | (ert-deftest cconv-tests-defsubst-:documentation () | ||
| 170 | "Docstring for defsubst can be specified with :documentation." | ||
| 171 | (should (string= (documentation 'cconv-tests-defsubst) | ||
| 172 | "defsubst documentation")) | ||
| 173 | (should (eq (cconv-tests-defsubst) 'defsubst-result))) | ||
| 174 | |||
| 175 | (cl-defsubst cconv-tests-cl-defsubst () | ||
| 176 | (:documentation (concat "cl-defsubst" " documentation")) | ||
| 177 | 'cl-defsubst-result) | ||
| 178 | (ert-deftest cconv-tests-cl-defsubst-:documentation () | ||
| 179 | "Docstring for cl-defsubst can be specified with :documentation." | ||
| 180 | (should (string= (documentation 'cconv-tests-cl-defsubst) | ||
| 181 | "cl-defsubst documentation")) | ||
| 182 | (should (eq (cconv-tests-cl-defsubst) 'cl-defsubst-result))) | ||
| 23 | 183 | ||
| 24 | (ert-deftest cconv-convert-lambda-lifted () | 184 | (ert-deftest cconv-convert-lambda-lifted () |
| 25 | "Bug#30872." | 185 | "Bug#30872." |
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 51c9884ddc8..5aa58782f36 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el | |||
| @@ -24,6 +24,7 @@ | |||
| 24 | ;;; Code: | 24 | ;;; Code: |
| 25 | 25 | ||
| 26 | (require 'cl-generic) | 26 | (require 'cl-generic) |
| 27 | (require 'edebug) | ||
| 27 | 28 | ||
| 28 | ;; Don't indirectly require `cl-lib' at run-time. | 29 | ;; Don't indirectly require `cl-lib' at run-time. |
| 29 | (eval-when-compile (require 'ert)) | 30 | (eval-when-compile (require 'ert)) |
| @@ -249,5 +250,42 @@ | |||
| 249 | (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic)) | 250 | (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic)) |
| 250 | (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods))) | 251 | (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods))) |
| 251 | 252 | ||
| 253 | (ert-deftest cl-defgeneric/edebug/method () | ||
| 254 | "Check that `:method' forms in `cl-defgeneric' create unique | ||
| 255 | Edebug symbols (Bug#42672)." | ||
| 256 | (with-temp-buffer | ||
| 257 | (dolist (form '((cl-defgeneric cl-defgeneric/edebug/method/1 (_) | ||
| 258 | (:method ((_ number)) 1) | ||
| 259 | (:method ((_ string)) 2) | ||
| 260 | (:method :around ((_ number)) 3)) | ||
| 261 | (cl-defgeneric cl-defgeneric/edebug/method/2 (_) | ||
| 262 | (:method ((_ number)) 3)))) | ||
| 263 | (print form (current-buffer))) | ||
| 264 | (let* ((edebug-all-defs t) | ||
| 265 | (edebug-initial-mode 'Go-nonstop) | ||
| 266 | (instrumented-names ()) | ||
| 267 | (edebug-new-definition-function | ||
| 268 | (lambda (name) | ||
| 269 | (when (memq name instrumented-names) | ||
| 270 | (error "Duplicate definition of `%s'" name)) | ||
| 271 | (push name instrumented-names) | ||
| 272 | (edebug-new-definition name))) | ||
| 273 | ;; Make generated symbols reproducible. | ||
| 274 | (gensym-counter 10000)) | ||
| 275 | (eval-buffer) | ||
| 276 | (should (equal | ||
| 277 | (reverse instrumented-names) | ||
| 278 | ;; The generic function definitions come after the | ||
| 279 | ;; method definitions because their body ends later. | ||
| 280 | ;; FIXME: We'd rather have names such as | ||
| 281 | ;; `cl-defgeneric/edebug/method/1 ((_ number))', but | ||
| 282 | ;; that requires further changes to Edebug. | ||
| 283 | (list (intern "cl-generic-:method@10000 ((_ number))") | ||
| 284 | (intern "cl-generic-:method@10001 ((_ string))") | ||
| 285 | (intern "cl-generic-:method@10002 :around ((_ number))") | ||
| 286 | 'cl-defgeneric/edebug/method/1 | ||
| 287 | (intern "cl-generic-:method@10003 ((_ number))") | ||
| 288 | 'cl-defgeneric/edebug/method/2)))))) | ||
| 289 | |||
| 252 | (provide 'cl-generic-tests) | 290 | (provide 'cl-generic-tests) |
| 253 | ;;; cl-generic-tests.el ends here | 291 | ;;; cl-generic-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/edebug-tests.el b/test/lisp/emacs-lisp/edebug-tests.el index 41811c9dc07..04a7b2f5a0f 100644 --- a/test/lisp/emacs-lisp/edebug-tests.el +++ b/test/lisp/emacs-lisp/edebug-tests.el | |||
| @@ -938,5 +938,99 @@ test and possibly others should be updated." | |||
| 938 | "g" | 938 | "g" |
| 939 | (should (equal edebug-tests-@-result '(0 1)))))) | 939 | (should (equal edebug-tests-@-result '(0 1)))))) |
| 940 | 940 | ||
| 941 | (ert-deftest edebug-cl-defmethod-qualifier () | ||
| 942 | "Check that secondary `cl-defmethod' forms don't stomp over | ||
| 943 | primary ones (Bug#42671)." | ||
| 944 | (with-temp-buffer | ||
| 945 | (let* ((edebug-all-defs t) | ||
| 946 | (edebug-initial-mode 'Go-nonstop) | ||
| 947 | (defined-symbols ()) | ||
| 948 | (edebug-new-definition-function | ||
| 949 | (lambda (def-name) | ||
| 950 | (push def-name defined-symbols) | ||
| 951 | (edebug-new-definition def-name)))) | ||
| 952 | (dolist (form '((cl-defmethod edebug-cl-defmethod-qualifier ((_ number))) | ||
| 953 | (cl-defmethod edebug-cl-defmethod-qualifier | ||
| 954 | :around ((_ number))))) | ||
| 955 | (print form (current-buffer))) | ||
| 956 | (eval-buffer) | ||
| 957 | (should | ||
| 958 | (equal | ||
| 959 | defined-symbols | ||
| 960 | (list (intern "edebug-cl-defmethod-qualifier :around ((_ number))") | ||
| 961 | (intern "edebug-cl-defmethod-qualifier ((_ number))"))))))) | ||
| 962 | |||
| 963 | (ert-deftest edebug-tests-cl-flet () | ||
| 964 | "Check that Edebug can instrument `cl-flet' forms without name | ||
| 965 | clashes (Bug#41853)." | ||
| 966 | (with-temp-buffer | ||
| 967 | (dolist (form '((defun edebug-tests-cl-flet-1 () | ||
| 968 | (cl-flet ((inner () 0)) (message "Hi")) | ||
| 969 | (cl-flet ((inner () 1)) (inner))) | ||
| 970 | (defun edebug-tests-cl-flet-2 () | ||
| 971 | (cl-flet ((inner () 2)) (inner))))) | ||
| 972 | (print form (current-buffer))) | ||
| 973 | (let* ((edebug-all-defs t) | ||
| 974 | (edebug-initial-mode 'Go-nonstop) | ||
| 975 | (instrumented-names ()) | ||
| 976 | (edebug-new-definition-function | ||
| 977 | (lambda (name) | ||
| 978 | (when (memq name instrumented-names) | ||
| 979 | (error "Duplicate definition of `%s'" name)) | ||
| 980 | (push name instrumented-names) | ||
| 981 | (edebug-new-definition name))) | ||
| 982 | ;; Make generated symbols reproducible. | ||
| 983 | (gensym-counter 10000)) | ||
| 984 | (eval-buffer) | ||
| 985 | (should (equal (reverse instrumented-names) | ||
| 986 | ;; The outer definitions come after the inner | ||
| 987 | ;; ones because their body ends later. | ||
| 988 | ;; FIXME: There are twice as many inner | ||
| 989 | ;; definitions as expected due to Bug#41988. | ||
| 990 | ;; Once that bug is fixed, remove the duplicates. | ||
| 991 | ;; FIXME: We'd rather have names such as | ||
| 992 | ;; `edebug-tests-cl-flet-1@inner@cl-flet@10000', | ||
| 993 | ;; but that requires further changes to Edebug. | ||
| 994 | '(inner@cl-flet@10000 | ||
| 995 | inner@cl-flet@10001 | ||
| 996 | inner@cl-flet@10002 | ||
| 997 | inner@cl-flet@10003 | ||
| 998 | edebug-tests-cl-flet-1 | ||
| 999 | inner@cl-flet@10004 | ||
| 1000 | inner@cl-flet@10005 | ||
| 1001 | edebug-tests-cl-flet-2)))))) | ||
| 1002 | |||
| 1003 | (ert-deftest edebug-tests-duplicate-symbol-backtrack () | ||
| 1004 | "Check that Edebug doesn't create duplicate symbols when | ||
| 1005 | backtracking (Bug#42701)." | ||
| 1006 | (with-temp-buffer | ||
| 1007 | (dolist (form '((require 'subr-x) | ||
| 1008 | (defun edebug-tests-duplicate-symbol-backtrack () | ||
| 1009 | (if-let (x (funcall (lambda (y) 1) 2)) 3 4)))) | ||
| 1010 | (print form (current-buffer))) | ||
| 1011 | (let* ((edebug-all-defs t) | ||
| 1012 | (edebug-initial-mode 'Go-nonstop) | ||
| 1013 | (instrumented-names ()) | ||
| 1014 | (edebug-new-definition-function | ||
| 1015 | (lambda (name) | ||
| 1016 | (when (memq name instrumented-names) | ||
| 1017 | (error "Duplicate definition of `%s'" name)) | ||
| 1018 | (push name instrumented-names) | ||
| 1019 | (edebug-new-definition name))) | ||
| 1020 | ;; Make generated symbols reproducible. | ||
| 1021 | (gensym-counter 10000)) | ||
| 1022 | (eval-buffer) | ||
| 1023 | ;; The anonymous symbols are uninterned. Use their names so we | ||
| 1024 | ;; can perform the assertion. The names should still be unique. | ||
| 1025 | (should (equal (mapcar #'symbol-name (reverse instrumented-names)) | ||
| 1026 | ;; The outer definition comes after the inner | ||
| 1027 | ;; ones because its body ends later. | ||
| 1028 | ;; FIXME: There are twice as many inner | ||
| 1029 | ;; definitions as expected due to Bug#42701. | ||
| 1030 | ;; Once that bug is fixed, remove the duplicates. | ||
| 1031 | '("edebug-anon10000" | ||
| 1032 | "edebug-anon10001" | ||
| 1033 | "edebug-tests-duplicate-symbol-backtrack")))))) | ||
| 1034 | |||
| 941 | (provide 'edebug-tests) | 1035 | (provide 'edebug-tests) |
| 942 | ;;; edebug-tests.el ends here | 1036 | ;;; edebug-tests.el ends here |
diff --git a/test/lisp/emacs-lisp/generator-tests.el b/test/lisp/emacs-lisp/generator-tests.el index 9b1a573ea6a..72eee07be8c 100644 --- a/test/lisp/emacs-lisp/generator-tests.el +++ b/test/lisp/emacs-lisp/generator-tests.el | |||
| @@ -22,6 +22,10 @@ | |||
| 22 | 22 | ||
| 23 | ;;; Commentary: | 23 | ;;; Commentary: |
| 24 | 24 | ||
| 25 | ;; Unit tests for generator.el. | ||
| 26 | |||
| 27 | ;;; Code: | ||
| 28 | |||
| 25 | (require 'generator) | 29 | (require 'generator) |
| 26 | (require 'ert) | 30 | (require 'ert) |
| 27 | (require 'cl-lib) | 31 | (require 'cl-lib) |
diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el b/test/lisp/emacs-lisp/hierarchy-tests.el new file mode 100644 index 00000000000..23cfc79d848 --- /dev/null +++ b/test/lisp/emacs-lisp/hierarchy-tests.el | |||
| @@ -0,0 +1,556 @@ | |||
| 1 | ;;; hierarchy-tests.el --- Tests for hierarchy.el | ||
| 2 | |||
| 3 | ;; Copyright (C) 2017-2019 Damien Cassou | ||
| 4 | |||
| 5 | ;; Author: Damien Cassou <damien@cassou.me> | ||
| 6 | ;; Maintainer: emacs-devel@gnu.org | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | ;; Tests for hierarchy.el | ||
| 26 | |||
| 27 | ;;; Code: | ||
| 28 | |||
| 29 | (require 'ert) | ||
| 30 | (require 'hierarchy) | ||
| 31 | |||
| 32 | (defun hierarchy-animals () | ||
| 33 | "Create a sorted animal hierarchy." | ||
| 34 | (let ((parentfn (lambda (item) (cl-case item | ||
| 35 | (dove 'bird) | ||
| 36 | (pigeon 'bird) | ||
| 37 | (bird 'animal) | ||
| 38 | (dolphin 'animal) | ||
| 39 | (cow 'animal)))) | ||
| 40 | (hierarchy (hierarchy-new))) | ||
| 41 | (hierarchy-add-tree hierarchy 'dove parentfn) | ||
| 42 | (hierarchy-add-tree hierarchy 'pigeon parentfn) | ||
| 43 | (hierarchy-add-tree hierarchy 'dolphin parentfn) | ||
| 44 | (hierarchy-add-tree hierarchy 'cow parentfn) | ||
| 45 | (hierarchy-sort hierarchy) | ||
| 46 | hierarchy)) | ||
| 47 | |||
| 48 | (ert-deftest hierarchy-add-one-root () | ||
| 49 | (let ((parentfn (lambda (_) nil)) | ||
| 50 | (hierarchy (hierarchy-new))) | ||
| 51 | (hierarchy-add-tree hierarchy 'animal parentfn) | ||
| 52 | (should (equal (hierarchy-roots hierarchy) '(animal))))) | ||
| 53 | |||
| 54 | (ert-deftest hierarchy-add-one-item-with-parent () | ||
| 55 | (let ((parentfn (lambda (item) | ||
| 56 | (cl-case item | ||
| 57 | (bird 'animal)))) | ||
| 58 | (hierarchy (hierarchy-new))) | ||
| 59 | (hierarchy-add-tree hierarchy 'bird parentfn) | ||
| 60 | (should (equal (hierarchy-roots hierarchy) '(animal))) | ||
| 61 | (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) | ||
| 62 | |||
| 63 | (ert-deftest hierarchy-add-one-item-with-parent-and-grand-parent () | ||
| 64 | (let ((parentfn (lambda (item) | ||
| 65 | (cl-case item | ||
| 66 | (dove 'bird) | ||
| 67 | (bird 'animal)))) | ||
| 68 | (hierarchy (hierarchy-new))) | ||
| 69 | (hierarchy-add-tree hierarchy 'dove parentfn) | ||
| 70 | (should (equal (hierarchy-roots hierarchy) '(animal))) | ||
| 71 | (should (equal (hierarchy-children hierarchy 'animal) '(bird))) | ||
| 72 | (should (equal (hierarchy-children hierarchy 'bird) '(dove))))) | ||
| 73 | |||
| 74 | (ert-deftest hierarchy-add-same-root-twice () | ||
| 75 | (let ((parentfn (lambda (_) nil)) | ||
| 76 | (hierarchy (hierarchy-new))) | ||
| 77 | (hierarchy-add-tree hierarchy 'animal parentfn) | ||
| 78 | (hierarchy-add-tree hierarchy 'animal parentfn) | ||
| 79 | (should (equal (hierarchy-roots hierarchy) '(animal))))) | ||
| 80 | |||
| 81 | (ert-deftest hierarchy-add-same-child-twice () | ||
| 82 | (let ((parentfn (lambda (item) | ||
| 83 | (cl-case item | ||
| 84 | (bird 'animal)))) | ||
| 85 | (hierarchy (hierarchy-new))) | ||
| 86 | (hierarchy-add-tree hierarchy 'bird parentfn) | ||
| 87 | (hierarchy-add-tree hierarchy 'bird parentfn) | ||
| 88 | (should (equal (hierarchy-roots hierarchy) '(animal))) | ||
| 89 | (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) | ||
| 90 | |||
| 91 | (ert-deftest hierarchy-add-item-and-its-parent () | ||
| 92 | (let ((parentfn (lambda (item) | ||
| 93 | (cl-case item | ||
| 94 | (bird 'animal)))) | ||
| 95 | (hierarchy (hierarchy-new))) | ||
| 96 | (hierarchy-add-tree hierarchy 'bird parentfn) | ||
| 97 | (hierarchy-add-tree hierarchy 'animal parentfn) | ||
| 98 | (should (equal (hierarchy-roots hierarchy) '(animal))) | ||
| 99 | (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) | ||
| 100 | |||
| 101 | (ert-deftest hierarchy-add-item-and-its-child () | ||
| 102 | (let ((parentfn (lambda (item) | ||
| 103 | (cl-case item | ||
| 104 | (bird 'animal)))) | ||
| 105 | (hierarchy (hierarchy-new))) | ||
| 106 | (hierarchy-add-tree hierarchy 'animal parentfn) | ||
| 107 | (hierarchy-add-tree hierarchy 'bird parentfn) | ||
| 108 | (should (equal (hierarchy-roots hierarchy) '(animal))) | ||
| 109 | (should (equal (hierarchy-children hierarchy 'animal) '(bird))))) | ||
| 110 | |||
| 111 | (ert-deftest hierarchy-add-two-items-sharing-parent () | ||
| 112 | (let ((parentfn (lambda (item) | ||
| 113 | (cl-case item | ||
| 114 | (dove 'bird) | ||
| 115 | (pigeon 'bird)))) | ||
| 116 | (hierarchy (hierarchy-new))) | ||
| 117 | (hierarchy-add-tree hierarchy 'dove parentfn) | ||
| 118 | (hierarchy-add-tree hierarchy 'pigeon parentfn) | ||
| 119 | (should (equal (hierarchy-roots hierarchy) '(bird))) | ||
| 120 | (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))))) | ||
| 121 | |||
| 122 | (ert-deftest hierarchy-add-two-hierarchies () | ||
| 123 | (let ((parentfn (lambda (item) | ||
| 124 | (cl-case item | ||
| 125 | (dove 'bird) | ||
| 126 | (circle 'shape)))) | ||
| 127 | (hierarchy (hierarchy-new))) | ||
| 128 | (hierarchy-add-tree hierarchy 'dove parentfn) | ||
| 129 | (hierarchy-add-tree hierarchy 'circle parentfn) | ||
| 130 | (should (equal (hierarchy-roots hierarchy) '(bird shape))) | ||
| 131 | (should (equal (hierarchy-children hierarchy 'bird) '(dove))) | ||
| 132 | (should (equal (hierarchy-children hierarchy 'shape) '(circle))))) | ||
| 133 | |||
| 134 | (ert-deftest hierarchy-add-with-childrenfn () | ||
| 135 | (let ((childrenfn (lambda (item) | ||
| 136 | (cl-case item | ||
| 137 | (animal '(bird)) | ||
| 138 | (bird '(dove pigeon))))) | ||
| 139 | (hierarchy (hierarchy-new))) | ||
| 140 | (hierarchy-add-tree hierarchy 'animal nil childrenfn) | ||
| 141 | (should (equal (hierarchy-roots hierarchy) '(animal))) | ||
| 142 | (should (equal (hierarchy-children hierarchy 'animal) '(bird))) | ||
| 143 | (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))))) | ||
| 144 | |||
| 145 | (ert-deftest hierarchy-add-with-parentfn-and-childrenfn () | ||
| 146 | (let ((parentfn (lambda (item) | ||
| 147 | (cl-case item | ||
| 148 | (bird 'animal) | ||
| 149 | (animal 'life-form)))) | ||
| 150 | (childrenfn (lambda (item) | ||
| 151 | (cl-case item | ||
| 152 | (bird '(dove pigeon)) | ||
| 153 | (pigeon '(ashy-wood-pigeon))))) | ||
| 154 | (hierarchy (hierarchy-new))) | ||
| 155 | (hierarchy-add-tree hierarchy 'bird parentfn childrenfn) | ||
| 156 | (should (equal (hierarchy-roots hierarchy) '(life-form))) | ||
| 157 | (should (equal (hierarchy-children hierarchy 'life-form) '(animal))) | ||
| 158 | (should (equal (hierarchy-children hierarchy 'animal) '(bird))) | ||
| 159 | (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))) | ||
| 160 | (should (equal (hierarchy-children hierarchy 'pigeon) '(ashy-wood-pigeon))))) | ||
| 161 | |||
| 162 | (ert-deftest hierarchy-add-twice-with-parentfn-and-childrenfn () | ||
| 163 | (let* ((parentfn (lambda (item) | ||
| 164 | (cl-case item | ||
| 165 | (dove 'bird) | ||
| 166 | (bird 'animal)))) | ||
| 167 | (childrenfn (lambda (item) | ||
| 168 | (cl-case item | ||
| 169 | (animal '(bird)) | ||
| 170 | (bird '(dove))))) | ||
| 171 | (hierarchy (hierarchy-new))) | ||
| 172 | (hierarchy-add-tree hierarchy 'bird parentfn childrenfn) | ||
| 173 | (should (equal (hierarchy-children hierarchy 'animal) '(bird))) | ||
| 174 | (should (equal (hierarchy-children hierarchy 'bird) '(dove))))) | ||
| 175 | |||
| 176 | (ert-deftest hierarchy-add-trees () | ||
| 177 | (let ((parentfn (lambda (item) | ||
| 178 | (cl-case item | ||
| 179 | (dove 'bird) | ||
| 180 | (pigeon 'bird) | ||
| 181 | (bird 'animal)))) | ||
| 182 | (hierarchy (hierarchy-new))) | ||
| 183 | (hierarchy-add-trees hierarchy '(dove pigeon) parentfn) | ||
| 184 | (should (equal (hierarchy-roots hierarchy) '(animal))) | ||
| 185 | (should (equal (hierarchy-children hierarchy 'animal) '(bird))) | ||
| 186 | (should (equal (hierarchy-children hierarchy 'bird) '(dove pigeon))))) | ||
| 187 | |||
| 188 | (ert-deftest hierarchy-from-list () | ||
| 189 | (let ((hierarchy (hierarchy-from-list | ||
| 190 | '(animal (bird (dove) | ||
| 191 | (pigeon)) | ||
| 192 | (cow) | ||
| 193 | (dolphin))))) | ||
| 194 | (hierarchy-sort hierarchy (lambda (item1 item2) | ||
| 195 | (string< (car item1) | ||
| 196 | (car item2)))) | ||
| 197 | (should (equal (hierarchy-to-string hierarchy (lambda (item) (symbol-name (car item)))) | ||
| 198 | "animal\n bird\n dove\n pigeon\n cow\n dolphin\n")))) | ||
| 199 | |||
| 200 | (ert-deftest hierarchy-from-list-with-duplicates () | ||
| 201 | (let ((hierarchy (hierarchy-from-list | ||
| 202 | '(a (b) (b)) | ||
| 203 | t))) | ||
| 204 | (hierarchy-sort hierarchy (lambda (item1 item2) | ||
| 205 | ;; sort by ID | ||
| 206 | (< (car item1) (car item2)))) | ||
| 207 | (should (equal (hierarchy-length hierarchy) 3)) | ||
| 208 | (should (equal (hierarchy-to-string | ||
| 209 | hierarchy | ||
| 210 | (lambda (item) | ||
| 211 | (format "%s(%s)" | ||
| 212 | (cadr item) | ||
| 213 | (car item)))) | ||
| 214 | "a(1)\n b(2)\n b(3)\n")))) | ||
| 215 | |||
| 216 | (ert-deftest hierarchy-from-list-with-childrenfn () | ||
| 217 | (let ((hierarchy (hierarchy-from-list | ||
| 218 | "abc" | ||
| 219 | nil | ||
| 220 | (lambda (item) | ||
| 221 | (when (string= item "abc") | ||
| 222 | (split-string item "" t)))))) | ||
| 223 | (hierarchy-sort hierarchy (lambda (item1 item2) (string< item1 item2))) | ||
| 224 | (should (equal (hierarchy-length hierarchy) 4)) | ||
| 225 | (should (equal (hierarchy-to-string hierarchy) | ||
| 226 | "abc\n a\n b\n c\n")))) | ||
| 227 | |||
| 228 | (ert-deftest hierarchy-add-relation-check-error-when-different-parent () | ||
| 229 | (let ((parentfn (lambda (item) | ||
| 230 | (cl-case item | ||
| 231 | (bird 'animal)))) | ||
| 232 | (hierarchy (hierarchy-new))) | ||
| 233 | (hierarchy-add-tree hierarchy 'bird parentfn) | ||
| 234 | (should-error | ||
| 235 | (hierarchy--add-relation hierarchy 'bird 'cow #'identity)))) | ||
| 236 | |||
| 237 | (ert-deftest hierarchy-empty-p-return-non-nil-for-empty () | ||
| 238 | (should (hierarchy-empty-p (hierarchy-new)))) | ||
| 239 | |||
| 240 | (ert-deftest hierarchy-empty-p-return-nil-for-non-empty () | ||
| 241 | (should-not (hierarchy-empty-p (hierarchy-animals)))) | ||
| 242 | |||
| 243 | (ert-deftest hierarchy-length-of-empty-is-0 () | ||
| 244 | (should (equal (hierarchy-length (hierarchy-new)) 0))) | ||
| 245 | |||
| 246 | (ert-deftest hierarchy-length-of-non-empty-counts-items () | ||
| 247 | (let ((parentfn (lambda (item) | ||
| 248 | (cl-case item | ||
| 249 | (bird 'animal) | ||
| 250 | (dove 'bird) | ||
| 251 | (pigeon 'bird)))) | ||
| 252 | (hierarchy (hierarchy-new))) | ||
| 253 | (hierarchy-add-tree hierarchy 'dove parentfn) | ||
| 254 | (hierarchy-add-tree hierarchy 'pigeon parentfn) | ||
| 255 | (should (equal (hierarchy-length hierarchy) 4)))) | ||
| 256 | |||
| 257 | (ert-deftest hierarchy-has-root () | ||
| 258 | (let ((parentfn (lambda (item) | ||
| 259 | (cl-case item | ||
| 260 | (bird 'animal) | ||
| 261 | (dove 'bird) | ||
| 262 | (pigeon 'bird)))) | ||
| 263 | (hierarchy (hierarchy-new))) | ||
| 264 | (should-not (hierarchy-has-root hierarchy 'animal)) | ||
| 265 | (should-not (hierarchy-has-root hierarchy 'bird)) | ||
| 266 | (hierarchy-add-tree hierarchy 'dove parentfn) | ||
| 267 | (hierarchy-add-tree hierarchy 'pigeon parentfn) | ||
| 268 | (should (hierarchy-has-root hierarchy 'animal)) | ||
| 269 | (should-not (hierarchy-has-root hierarchy 'bird)))) | ||
| 270 | |||
| 271 | (ert-deftest hierarchy-leafs () | ||
| 272 | (let ((animals (hierarchy-animals))) | ||
| 273 | (should (equal (hierarchy-leafs animals) | ||
| 274 | '(dove pigeon dolphin cow))))) | ||
| 275 | |||
| 276 | (ert-deftest hierarchy-leafs-includes-lonely-roots () | ||
| 277 | (let ((parentfn (lambda (item) nil)) | ||
| 278 | (hierarchy (hierarchy-new))) | ||
| 279 | (hierarchy-add-tree hierarchy 'foo parentfn) | ||
| 280 | (should (equal (hierarchy-leafs hierarchy) | ||
| 281 | '(foo))))) | ||
| 282 | |||
| 283 | (ert-deftest hierarchy-leafs-of-node () | ||
| 284 | (let ((animals (hierarchy-animals))) | ||
| 285 | (should (equal (hierarchy-leafs animals 'cow) '())) | ||
| 286 | (should (equal (hierarchy-leafs animals 'animal) '(dove pigeon dolphin cow))) | ||
| 287 | (should (equal (hierarchy-leafs animals 'bird) '(dove pigeon))) | ||
| 288 | (should (equal (hierarchy-leafs animals 'dove) '())))) | ||
| 289 | |||
| 290 | (ert-deftest hierarchy-child-p () | ||
| 291 | (let ((animals (hierarchy-animals))) | ||
| 292 | (should (hierarchy-child-p animals 'dove 'bird)) | ||
| 293 | (should (hierarchy-child-p animals 'bird 'animal)) | ||
| 294 | (should (hierarchy-child-p animals 'cow 'animal)) | ||
| 295 | (should-not (hierarchy-child-p animals 'cow 'bird)) | ||
| 296 | (should-not (hierarchy-child-p animals 'bird 'cow)) | ||
| 297 | (should-not (hierarchy-child-p animals 'animal 'dove)) | ||
| 298 | (should-not (hierarchy-child-p animals 'animal 'bird)))) | ||
| 299 | |||
| 300 | (ert-deftest hierarchy-descendant () | ||
| 301 | (let ((animals (hierarchy-animals))) | ||
| 302 | (should (hierarchy-descendant-p animals 'dove 'animal)) | ||
| 303 | (should (hierarchy-descendant-p animals 'dove 'bird)) | ||
| 304 | (should (hierarchy-descendant-p animals 'bird 'animal)) | ||
| 305 | (should (hierarchy-descendant-p animals 'cow 'animal)) | ||
| 306 | (should-not (hierarchy-descendant-p animals 'cow 'bird)) | ||
| 307 | (should-not (hierarchy-descendant-p animals 'bird 'cow)) | ||
| 308 | (should-not (hierarchy-descendant-p animals 'animal 'dove)) | ||
| 309 | (should-not (hierarchy-descendant-p animals 'animal 'bird)))) | ||
| 310 | |||
| 311 | (ert-deftest hierarchy-descendant-if-not-same () | ||
| 312 | (let ((animals (hierarchy-animals))) | ||
| 313 | (should-not (hierarchy-descendant-p animals 'cow 'cow)) | ||
| 314 | (should-not (hierarchy-descendant-p animals 'dove 'dove)) | ||
| 315 | (should-not (hierarchy-descendant-p animals 'bird 'bird)) | ||
| 316 | (should-not (hierarchy-descendant-p animals 'animal 'animal)))) | ||
| 317 | |||
| 318 | ;; keywords supported: :test :key | ||
| 319 | (ert-deftest hierarchy--set-equal () | ||
| 320 | (should (hierarchy--set-equal '(1 2 3) '(1 2 3))) | ||
| 321 | (should (hierarchy--set-equal '(1 2 3) '(3 2 1))) | ||
| 322 | (should (hierarchy--set-equal '(3 2 1) '(1 2 3))) | ||
| 323 | (should-not (hierarchy--set-equal '(2 3) '(3 2 1))) | ||
| 324 | (should-not (hierarchy--set-equal '(1 2 3) '(2 3))) | ||
| 325 | (should-not (hierarchy--set-equal '("1" "2") '("2" "1") :test #'eq)) | ||
| 326 | (should (hierarchy--set-equal '("1" "2") '("2" "1") :test #'equal)) | ||
| 327 | (should-not (hierarchy--set-equal '(1 2) '(-1 -2))) | ||
| 328 | (should (hierarchy--set-equal '(1 2) '(-1 -2) :key #'abs)) | ||
| 329 | (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)))) | ||
| 330 | (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car)) | ||
| 331 | (should-not (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :test #'equal)) | ||
| 332 | (should (hierarchy--set-equal '(("1" 1) ("2" 1)) '(("1" 2) ("2" 2)) :key #'car :test #'equal))) | ||
| 333 | |||
| 334 | (ert-deftest hierarchy-equal-returns-true-for-same-hierarchy () | ||
| 335 | (let ((animals (hierarchy-animals))) | ||
| 336 | (should (hierarchy-equal animals animals)) | ||
| 337 | (should (hierarchy-equal (hierarchy-animals) animals)))) | ||
| 338 | |||
| 339 | (ert-deftest hierarchy-equal-returns-true-for-hierarchy-copies () | ||
| 340 | (let ((animals (hierarchy-animals))) | ||
| 341 | (should (hierarchy-equal animals (hierarchy-copy animals))))) | ||
| 342 | |||
| 343 | (ert-deftest hierarchy-map-item-on-leaf () | ||
| 344 | (let* ((animals (hierarchy-animals)) | ||
| 345 | (result (hierarchy-map-item (lambda (item indent) (cons item indent)) | ||
| 346 | 'cow | ||
| 347 | animals))) | ||
| 348 | (should (equal result '((cow . 0)))))) | ||
| 349 | |||
| 350 | (ert-deftest hierarchy-map-item-on-leaf-with-indent () | ||
| 351 | (let* ((animals (hierarchy-animals)) | ||
| 352 | (result (hierarchy-map-item (lambda (item indent) (cons item indent)) | ||
| 353 | 'cow | ||
| 354 | animals | ||
| 355 | 2))) | ||
| 356 | (should (equal result '((cow . 2)))))) | ||
| 357 | |||
| 358 | (ert-deftest hierarchy-map-item-on-parent () | ||
| 359 | (let* ((animals (hierarchy-animals)) | ||
| 360 | (result (hierarchy-map-item (lambda (item indent) (cons item indent)) | ||
| 361 | 'bird | ||
| 362 | animals))) | ||
| 363 | (should (equal result '((bird . 0) (dove . 1) (pigeon . 1)))))) | ||
| 364 | |||
| 365 | (ert-deftest hierarchy-map-item-on-grand-parent () | ||
| 366 | (let* ((animals (hierarchy-animals)) | ||
| 367 | (result (hierarchy-map-item (lambda (item indent) (cons item indent)) | ||
| 368 | 'animal | ||
| 369 | animals))) | ||
| 370 | (should (equal result '((animal . 0) (bird . 1) (dove . 2) (pigeon . 2) | ||
| 371 | (cow . 1) (dolphin . 1)))))) | ||
| 372 | |||
| 373 | (ert-deftest hierarchy-map-conses () | ||
| 374 | (let* ((animals (hierarchy-animals)) | ||
| 375 | (result (hierarchy-map (lambda (item indent) | ||
| 376 | (cons item indent)) | ||
| 377 | animals))) | ||
| 378 | (should (equal result '((animal . 0) | ||
| 379 | (bird . 1) | ||
| 380 | (dove . 2) | ||
| 381 | (pigeon . 2) | ||
| 382 | (cow . 1) | ||
| 383 | (dolphin . 1)))))) | ||
| 384 | |||
| 385 | (ert-deftest hierarchy-map-tree () | ||
| 386 | (let ((animals (hierarchy-animals))) | ||
| 387 | (should (equal (hierarchy-map-tree (lambda (item indent children) | ||
| 388 | (list item indent children)) | ||
| 389 | animals) | ||
| 390 | '(animal | ||
| 391 | 0 | ||
| 392 | ((bird 1 ((dove 2 nil) (pigeon 2 nil))) | ||
| 393 | (cow 1 nil) | ||
| 394 | (dolphin 1 nil))))))) | ||
| 395 | |||
| 396 | (ert-deftest hierarchy-map-hierarchy-keeps-hierarchy () | ||
| 397 | (let* ((animals (hierarchy-animals)) | ||
| 398 | (result (hierarchy-map-hierarchy (lambda (item _) (identity item)) | ||
| 399 | animals))) | ||
| 400 | (should (hierarchy-equal animals result)))) | ||
| 401 | |||
| 402 | (ert-deftest hierarchy-map-applies-function () | ||
| 403 | (let* ((animals (hierarchy-animals)) | ||
| 404 | (parentfn (lambda (item) | ||
| 405 | (cond | ||
| 406 | ((equal item "bird") "animal") | ||
| 407 | ((equal item "dove") "bird") | ||
| 408 | ((equal item "pigeon") "bird") | ||
| 409 | ((equal item "cow") "animal") | ||
| 410 | ((equal item "dolphin") "animal")))) | ||
| 411 | (expected (hierarchy-new))) | ||
| 412 | (hierarchy-add-tree expected "dove" parentfn) | ||
| 413 | (hierarchy-add-tree expected "pigeon" parentfn) | ||
| 414 | (hierarchy-add-tree expected "cow" parentfn) | ||
| 415 | (hierarchy-add-tree expected "dolphin" parentfn) | ||
| 416 | (should (hierarchy-equal | ||
| 417 | (hierarchy-map-hierarchy (lambda (item _) (symbol-name item)) animals) | ||
| 418 | expected)))) | ||
| 419 | |||
| 420 | (ert-deftest hierarchy-extract-tree () | ||
| 421 | (let* ((animals (hierarchy-animals)) | ||
| 422 | (birds (hierarchy-extract-tree animals 'bird))) | ||
| 423 | (hierarchy-sort birds) | ||
| 424 | (should (equal (hierarchy-roots birds) '(animal))) | ||
| 425 | (should (equal (hierarchy-children birds 'animal) '(bird))) | ||
| 426 | (should (equal (hierarchy-children birds 'bird) '(dove pigeon))))) | ||
| 427 | |||
| 428 | (ert-deftest hierarchy-extract-tree-nil-if-not-in-hierarchy () | ||
| 429 | (let* ((animals (hierarchy-animals))) | ||
| 430 | (should-not (hierarchy-extract-tree animals 'foobar)))) | ||
| 431 | |||
| 432 | (ert-deftest hierarchy-items-of-empty-hierarchy-is-empty () | ||
| 433 | (should (seq-empty-p (hierarchy-items (hierarchy-new))))) | ||
| 434 | |||
| 435 | (ert-deftest hierarchy-items-returns-sequence-of-same-length () | ||
| 436 | (let* ((animals (hierarchy-animals)) | ||
| 437 | (result (hierarchy-items animals))) | ||
| 438 | (should (= (seq-length result) (hierarchy-length animals))))) | ||
| 439 | |||
| 440 | (ert-deftest hierarchy-items-return-all-elements-of-hierarchy () | ||
| 441 | (let* ((animals (hierarchy-animals)) | ||
| 442 | (result (hierarchy-items animals))) | ||
| 443 | (should (equal (seq-sort #'string< result) '(animal bird cow dolphin dove pigeon))))) | ||
| 444 | |||
| 445 | (ert-deftest hierarchy-labelfn-indent-no-indent-if-0 () | ||
| 446 | (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) | ||
| 447 | (labelfn (hierarchy-labelfn-indent labelfn-base))) | ||
| 448 | (should (equal | ||
| 449 | (with-temp-buffer | ||
| 450 | (funcall labelfn "bar" 0) | ||
| 451 | (buffer-substring (point-min) (point-max))) | ||
| 452 | "foo")))) | ||
| 453 | |||
| 454 | (ert-deftest hierarchy-labelfn-indent-three-times-if-3 () | ||
| 455 | (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) | ||
| 456 | (labelfn (hierarchy-labelfn-indent labelfn-base))) | ||
| 457 | (should (equal | ||
| 458 | (with-temp-buffer | ||
| 459 | (funcall labelfn "bar" 3) | ||
| 460 | (buffer-substring (point-min) (point-max))) | ||
| 461 | " foo")))) | ||
| 462 | |||
| 463 | (ert-deftest hierarchy-labelfn-indent-default-indent-string () | ||
| 464 | (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) | ||
| 465 | (labelfn (hierarchy-labelfn-indent labelfn-base))) | ||
| 466 | (should (equal | ||
| 467 | (with-temp-buffer | ||
| 468 | (funcall labelfn "bar" 1) | ||
| 469 | (buffer-substring (point-min) (point-max))) | ||
| 470 | " foo")))) | ||
| 471 | |||
| 472 | (ert-deftest hierarchy-labelfn-indent-custom-indent-string () | ||
| 473 | (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) | ||
| 474 | (labelfn (hierarchy-labelfn-indent labelfn-base "###")) | ||
| 475 | (content (with-temp-buffer | ||
| 476 | (funcall labelfn "bar" 1) | ||
| 477 | (buffer-substring (point-min) (point-max))))) | ||
| 478 | (should (equal content "###foo")))) | ||
| 479 | |||
| 480 | (ert-deftest hierarchy-labelfn-button-propertize () | ||
| 481 | (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) | ||
| 482 | (actionfn #'identity) | ||
| 483 | (labelfn (hierarchy-labelfn-button labelfn-base actionfn)) | ||
| 484 | (properties (with-temp-buffer | ||
| 485 | (funcall labelfn "bar" 1) | ||
| 486 | (text-properties-at 1)))) | ||
| 487 | (should (equal (car properties) 'action)))) | ||
| 488 | |||
| 489 | (ert-deftest hierarchy-labelfn-button-execute-labelfn () | ||
| 490 | (let* ((labelfn-base (lambda (_item _indent) (insert "foo"))) | ||
| 491 | (actionfn #'identity) | ||
| 492 | (labelfn (hierarchy-labelfn-button labelfn-base actionfn)) | ||
| 493 | (content (with-temp-buffer | ||
| 494 | (funcall labelfn "bar" 1) | ||
| 495 | (buffer-substring-no-properties (point-min) (point-max))))) | ||
| 496 | (should (equal content "foo")))) | ||
| 497 | |||
| 498 | (ert-deftest hierarchy-labelfn-button-if-does-not-button-unless-condition () | ||
| 499 | (let ((labelfn-base (lambda (_item _indent) (insert "foo"))) | ||
| 500 | (spy-count 0) | ||
| 501 | (condition (lambda (_item _indent) nil))) | ||
| 502 | (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count))))) | ||
| 503 | (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil) | ||
| 504 | (should (equal spy-count 0))))) | ||
| 505 | |||
| 506 | (ert-deftest hierarchy-labelfn-button-if-does-button-when-condition () | ||
| 507 | (let ((labelfn-base (lambda (_item _indent) (insert "foo"))) | ||
| 508 | (spy-count 0) | ||
| 509 | (condition (lambda (_item _indent) t))) | ||
| 510 | (cl-letf (((symbol-function 'hierarchy-labelfn-button) (lambda (_labelfn _actionfn) (lambda (_item _indent) (cl-incf spy-count))))) | ||
| 511 | (funcall (hierarchy-labelfn-button-if labelfn-base condition #'identity) nil nil) | ||
| 512 | (should (equal spy-count 1))))) | ||
| 513 | |||
| 514 | (ert-deftest hierarchy-labelfn-to-string () | ||
| 515 | (let ((labelfn (lambda (item _indent) (insert item)))) | ||
| 516 | (should (equal (hierarchy-labelfn-to-string labelfn "foo" 1) "foo")))) | ||
| 517 | |||
| 518 | (ert-deftest hierarchy-print () | ||
| 519 | (let* ((animals (hierarchy-animals)) | ||
| 520 | (result (with-temp-buffer | ||
| 521 | (hierarchy-print animals) | ||
| 522 | (buffer-substring-no-properties (point-min) (point-max))))) | ||
| 523 | (should (equal result "animal\n bird\n dove\n pigeon\n cow\n dolphin\n")))) | ||
| 524 | |||
| 525 | (ert-deftest hierarchy-to-string () | ||
| 526 | (let* ((animals (hierarchy-animals)) | ||
| 527 | (result (hierarchy-to-string animals))) | ||
| 528 | (should (equal result "animal\n bird\n dove\n pigeon\n cow\n dolphin\n")))) | ||
| 529 | |||
| 530 | (ert-deftest hierarchy-tabulated-display () | ||
| 531 | (let* ((animals (hierarchy-animals)) | ||
| 532 | (labelfn (lambda (item _indent) (insert (symbol-name item)))) | ||
| 533 | (contents (with-temp-buffer | ||
| 534 | (hierarchy-tabulated-display animals labelfn (current-buffer)) | ||
| 535 | (buffer-substring-no-properties (point-min) (point-max))))) | ||
| 536 | (should (equal contents "animal\nbird\ndove\npigeon\ncow\ndolphin\n")))) | ||
| 537 | |||
| 538 | (ert-deftest hierarchy-sort-non-root-nodes () | ||
| 539 | (let* ((animals (hierarchy-animals))) | ||
| 540 | (should (equal (hierarchy-roots animals) '(animal))) | ||
| 541 | (should (equal (hierarchy-children animals 'animal) '(bird cow dolphin))) | ||
| 542 | (should (equal (hierarchy-children animals 'bird) '(dove pigeon))))) | ||
| 543 | |||
| 544 | (ert-deftest hierarchy-sort-roots () | ||
| 545 | (let* ((organisms (hierarchy-new)) | ||
| 546 | (parentfn (lambda (item) | ||
| 547 | (cl-case item | ||
| 548 | (oak 'plant) | ||
| 549 | (bird 'animal))))) | ||
| 550 | (hierarchy-add-tree organisms 'oak parentfn) | ||
| 551 | (hierarchy-add-tree organisms 'bird parentfn) | ||
| 552 | (hierarchy-sort organisms) | ||
| 553 | (should (equal (hierarchy-roots organisms) '(animal plant))))) | ||
| 554 | |||
| 555 | (provide 'hierarchy-tests) | ||
| 556 | ;;; hierarchy-tests.el ends here | ||
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el new file mode 100644 index 00000000000..27f48fa8131 --- /dev/null +++ b/test/lisp/erc/erc-tests.el | |||
| @@ -0,0 +1,47 @@ | |||
| 1 | ;;; erc-tests.el --- Tests for erc. -*- lexical-binding:t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Lars Ingebrigtsen <larsi@gnus.org> | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 12 | ;; (at your option) any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 21 | |||
| 22 | ;;; Code: | ||
| 23 | |||
| 24 | (require 'ert) | ||
| 25 | (require 'erc) | ||
| 26 | |||
| 27 | (ert-deftest erc--read-time-period () | ||
| 28 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) ""))) | ||
| 29 | (should (equal (erc--read-time-period "foo: ") nil))) | ||
| 30 | |||
| 31 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) " "))) | ||
| 32 | (should (equal (erc--read-time-period "foo: ") nil))) | ||
| 33 | |||
| 34 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) " 432 "))) | ||
| 35 | (should (equal (erc--read-time-period "foo: ") 432))) | ||
| 36 | |||
| 37 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "432"))) | ||
| 38 | (should (equal (erc--read-time-period "foo: ") 432))) | ||
| 39 | |||
| 40 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1h"))) | ||
| 41 | (should (equal (erc--read-time-period "foo: ") 3600))) | ||
| 42 | |||
| 43 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1h10s"))) | ||
| 44 | (should (equal (erc--read-time-period "foo: ") 3610))) | ||
| 45 | |||
| 46 | (cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d"))) | ||
| 47 | (should (equal (erc--read-time-period "foo: ") 86400)))) | ||
diff --git a/test/lisp/gnus/gnus-util-tests.el b/test/lisp/gnus/gnus-util-tests.el new file mode 100644 index 00000000000..b01e2fc2966 --- /dev/null +++ b/test/lisp/gnus/gnus-util-tests.el | |||
| @@ -0,0 +1,76 @@ | |||
| 1 | ;;; gnus-util-tests.el --- Selectived tests only. | ||
| 2 | ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. | ||
| 3 | |||
| 4 | ;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org> | ||
| 5 | |||
| 6 | ;; This file is not part of GNU Emacs. | ||
| 7 | |||
| 8 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 11 | ;; any later version. | ||
| 12 | |||
| 13 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | ;;; Commentary: | ||
| 22 | |||
| 23 | ;;; Code: | ||
| 24 | |||
| 25 | (require 'ert) | ||
| 26 | (require 'gnus-util) | ||
| 27 | |||
| 28 | (ert-deftest gnus-subsetp () | ||
| 29 | ;; False for non-lists. | ||
| 30 | (should-not (gnus-subsetp "1" "1")) | ||
| 31 | (should-not (gnus-subsetp "1" '("1"))) | ||
| 32 | (should-not (gnus-subsetp '("1") "1")) | ||
| 33 | |||
| 34 | ;; Real tests. | ||
| 35 | (should (gnus-subsetp '() '())) | ||
| 36 | (should (gnus-subsetp '() '("1"))) | ||
| 37 | (should (gnus-subsetp '("1") '("1"))) | ||
| 38 | (should (gnus-subsetp '(42) '("1" 42))) | ||
| 39 | (should (gnus-subsetp '(42) '(42 "1"))) | ||
| 40 | (should (gnus-subsetp '(42) '("1" 42 2))) | ||
| 41 | (should-not (gnus-subsetp '("1") '())) | ||
| 42 | (should-not (gnus-subsetp '("1") '(2))) | ||
| 43 | (should-not (gnus-subsetp '("1" 2) '(2))) | ||
| 44 | (should-not (gnus-subsetp '(2 "1") '(2))) | ||
| 45 | (should-not (gnus-subsetp '("1" 2) '(2 3))) | ||
| 46 | |||
| 47 | ;; Duplicates don't matter for sets. | ||
| 48 | (should (gnus-subsetp '("1" "1") '("1"))) | ||
| 49 | (should (gnus-subsetp '("1" 2 "1") '(2 "1"))) | ||
| 50 | (should (gnus-subsetp '("1" 2 "1") '(2 "1" "1" 2))) | ||
| 51 | (should-not (gnus-subsetp '("1" 2 "1" 3) '(2 "1" "1" 2)))) | ||
| 52 | |||
| 53 | (ert-deftest gnus-setdiff () | ||
| 54 | ;; False for non-lists. | ||
| 55 | (should-not (gnus-setdiff "1" "1")) | ||
| 56 | (should-not (gnus-setdiff "1" '())) | ||
| 57 | (should-not (gnus-setdiff '() "1")) | ||
| 58 | |||
| 59 | ;; Real tests. | ||
| 60 | (should-not (gnus-setdiff '() '())) | ||
| 61 | (should-not (gnus-setdiff '() '("1"))) | ||
| 62 | (should-not (gnus-setdiff '("1") '("1"))) | ||
| 63 | (should (equal '("1") (gnus-setdiff '("1") '()))) | ||
| 64 | (should (equal '("1") (gnus-setdiff '("1") '(2)))) | ||
| 65 | (should (equal '("1") (gnus-setdiff '("1" 2) '(2)))) | ||
| 66 | (should (equal '("1") (gnus-setdiff '("1" 2 3) '(3 2)))) | ||
| 67 | (should (equal '("1") (gnus-setdiff '(2 "1" 3) '(3 2)))) | ||
| 68 | (should (equal '("1") (gnus-setdiff '(2 3 "1") '(3 2)))) | ||
| 69 | (should (equal '(2 "1") (gnus-setdiff '(2 3 "1") '(3)))) | ||
| 70 | |||
| 71 | ;; Duplicates aren't touched for sets if they are not removed. | ||
| 72 | (should-not (gnus-setdiff '("1" "1") '("1"))) | ||
| 73 | (should (equal '("1") (gnus-setdiff '(2 "1" 2) '(2)))) | ||
| 74 | (should (equal '("1" "1") (gnus-setdiff '(2 "1" 2 "1") '(2))))) | ||
| 75 | |||
| 76 | ;;; gnustest-gnus-util.el ends here | ||
diff --git a/test/lisp/gnus/mml-sec-tests.el b/test/lisp/gnus/mml-sec-tests.el new file mode 100644 index 00000000000..8f78a66f616 --- /dev/null +++ b/test/lisp/gnus/mml-sec-tests.el | |||
| @@ -0,0 +1,895 @@ | |||
| 1 | ;;; gnustest-mml-sec.el --- Tests mml-sec.el, see README-mml-secure.txt. | ||
| 2 | ;; Copyright (C) 2015 Free Software Foundation, Inc. | ||
| 3 | |||
| 4 | ;; Author: Jens Lechtenbörger <jens.lechtenboerger@fsfe.org> | ||
| 5 | |||
| 6 | ;; This file is not part of GNU Emacs. | ||
| 7 | |||
| 8 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 9 | ;; it under the terms of the GNU General Public License as published by | ||
| 10 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 11 | ;; any later version. | ||
| 12 | |||
| 13 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 16 | ;; GNU General Public License for more details. | ||
| 17 | |||
| 18 | ;; You should have received a copy of the GNU General Public License | ||
| 19 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | ||
| 20 | |||
| 21 | ;;; Commentary: | ||
| 22 | |||
| 23 | ;;; Code: | ||
| 24 | |||
| 25 | (require 'ert) | ||
| 26 | |||
| 27 | (require 'message) | ||
| 28 | (require 'epa) | ||
| 29 | (require 'epg) | ||
| 30 | (require 'mml-sec) | ||
| 31 | (require 'gnus-sum) | ||
| 32 | |||
| 33 | (defvar with-smime nil | ||
| 34 | "If nil, exclude S/MIME from tests as passphrases need to entered manually. | ||
| 35 | Mostly, the empty passphrase is used. However, the keys for | ||
| 36 | \"No Expiry two UIDs\" have the passphrase \"Passphrase\" (for OpenPGP as well | ||
| 37 | as S/MIME).") | ||
| 38 | |||
| 39 | (defun test-conf () | ||
| 40 | (ignore-errors (epg-configuration))) | ||
| 41 | |||
| 42 | (defun enc-standards () | ||
| 43 | (if with-smime '(enc-pgp enc-pgp-mime enc-smime) | ||
| 44 | '(enc-pgp enc-pgp-mime))) | ||
| 45 | (defun enc-sign-standards () | ||
| 46 | (if with-smime | ||
| 47 | '(enc-sign-pgp enc-sign-pgp-mime enc-sign-smime) | ||
| 48 | '(enc-sign-pgp enc-sign-pgp-mime))) | ||
| 49 | (defun sign-standards () | ||
| 50 | (if with-smime | ||
| 51 | '(sign-pgp sign-pgp-mime sign-smime) | ||
| 52 | '(sign-pgp sign-pgp-mime))) | ||
| 53 | |||
| 54 | (defun mml-secure-test-fixture (body &optional interactive) | ||
| 55 | "Setup GnuPG home containing test keys and prepare environment for BODY. | ||
| 56 | If optional INTERACTIVE is non-nil, allow questions to the user in case of | ||
| 57 | key problems. | ||
| 58 | This fixture temporarily unsets GPG_AGENT_INFO to enable passphrase tests, | ||
| 59 | which will neither work with gpgsm nor GnuPG 2.1 any longer, I guess. | ||
| 60 | Actually, I'm not sure why people would want to cache passwords in Emacs | ||
| 61 | instead of gpg-agent." | ||
| 62 | (unwind-protect | ||
| 63 | (let ((agent-info (getenv "GPG_AGENT_INFO")) | ||
| 64 | (gpghome (getenv "GNUPGHOME"))) | ||
| 65 | (condition-case error | ||
| 66 | (let ((epg-gpg-home-directory | ||
| 67 | (expand-file-name "test/data/mml-sec" source-directory)) | ||
| 68 | (mml-secure-allow-signing-with-unknown-recipient t) | ||
| 69 | (mml-smime-use 'epg) | ||
| 70 | ;; Create debug output in empty epg-debug-buffer. | ||
| 71 | (epg-debug t) | ||
| 72 | (epg-debug-buffer (get-buffer-create " *epg-test*")) | ||
| 73 | (mml-secure-fail-when-key-problem (not interactive))) | ||
| 74 | (with-current-buffer epg-debug-buffer | ||
| 75 | (erase-buffer)) | ||
| 76 | ;; Unset GPG_AGENT_INFO to enable passphrase caching inside Emacs. | ||
| 77 | ;; Just for testing. Jens does not recommend this for daily use. | ||
| 78 | (setenv "GPG_AGENT_INFO") | ||
| 79 | ;; Set GNUPGHOME as gpg-agent started by gpgsm does | ||
| 80 | ;; not look in the proper places otherwise, see: | ||
| 81 | ;; https://bugs.gnupg.org/gnupg/issue2126 | ||
| 82 | (setenv "GNUPGHOME" epg-gpg-home-directory) | ||
| 83 | (funcall body)) | ||
| 84 | (error | ||
| 85 | (setenv "GPG_AGENT_INFO" agent-info) | ||
| 86 | (setenv "GNUPGHOME" gpghome) | ||
| 87 | (signal (car error) (cdr error)))) | ||
| 88 | (setenv "GPG_AGENT_INFO" agent-info) | ||
| 89 | (setenv "GNUPGHOME" gpghome)))) | ||
| 90 | |||
| 91 | (defun mml-secure-test-message-setup (method to from &optional text bcc) | ||
| 92 | "Setup a buffer with MML METHOD, TO, and FROM headers. | ||
| 93 | Optionally, a message TEXT and BCC header can be passed." | ||
| 94 | (with-temp-buffer | ||
| 95 | (when bcc (insert (format "Bcc: %s\n" bcc))) | ||
| 96 | (insert (format "To: %s | ||
| 97 | From: %s | ||
| 98 | Subject: Test | ||
| 99 | %s\n" to from mail-header-separator)) | ||
| 100 | (if text | ||
| 101 | (insert (format "%s" text)) | ||
| 102 | (spook)) | ||
| 103 | (cond ((eq method 'enc-pgp-mime) | ||
| 104 | (mml-secure-message-encrypt-pgpmime 'nosig)) | ||
| 105 | ((eq method 'enc-sign-pgp-mime) | ||
| 106 | (mml-secure-message-encrypt-pgpmime)) | ||
| 107 | ((eq method 'enc-pgp) (mml-secure-message-encrypt-pgp 'nosig)) | ||
| 108 | ((eq method 'enc-sign-pgp) (mml-secure-message-encrypt-pgp)) | ||
| 109 | ((eq method 'enc-smime) (mml-secure-message-encrypt-smime 'nosig)) | ||
| 110 | ((eq method 'enc-sign-smime) (mml-secure-message-encrypt-smime)) | ||
| 111 | ((eq method 'sign-pgp-mime) (mml-secure-message-sign-pgpmime)) | ||
| 112 | ((eq method 'sign-pgp) (mml-secure-message-sign-pgp)) | ||
| 113 | ((eq method 'sign-smime) (mml-secure-message-sign-smime)) | ||
| 114 | (t (error "Unknown method"))) | ||
| 115 | (buffer-string))) | ||
| 116 | |||
| 117 | (defun mml-secure-test-mail-fixture (method to from body2 | ||
| 118 | &optional interactive) | ||
| 119 | "Setup buffer encrypted using METHOD for TO from FROM, call BODY2. | ||
| 120 | Pass optional INTERACTIVE to mml-secure-test-fixture." | ||
| 121 | (mml-secure-test-fixture | ||
| 122 | (lambda () | ||
| 123 | (let ((context (if (memq method '(enc-smime enc-sign-smime sign-smime)) | ||
| 124 | (epg-make-context 'CMS) | ||
| 125 | (epg-make-context 'OpenPGP))) | ||
| 126 | ;; Verify and decrypt by default. | ||
| 127 | (mm-verify-option 'known) | ||
| 128 | (mm-decrypt-option 'known) | ||
| 129 | (plaintext "The Magic Words are Squeamish Ossifrage")) | ||
| 130 | (with-temp-buffer | ||
| 131 | (insert (mml-secure-test-message-setup method to from plaintext)) | ||
| 132 | (message-options-set-recipient) | ||
| 133 | (message-encode-message-body) | ||
| 134 | ;; Replace separator line with newline. | ||
| 135 | (goto-char (point-min)) | ||
| 136 | (re-search-forward | ||
| 137 | (concat "^" (regexp-quote mail-header-separator) "\n")) | ||
| 138 | (replace-match "\n") | ||
| 139 | ;; The following treatment of handles, plainbuf, and multipart | ||
| 140 | ;; resulted from trial-and-error. | ||
| 141 | ;; Someone with more knowledge on how to decrypt messages and verify | ||
| 142 | ;; signatures might know more appropriate functions to invoke | ||
| 143 | ;; instead. | ||
| 144 | (let* ((handles (or (mm-dissect-buffer) | ||
| 145 | (mm-uu-dissect))) | ||
| 146 | (isplain (bufferp (car handles))) | ||
| 147 | (ismultipart (equal (car handles) "multipart/mixed")) | ||
| 148 | (plainbuf (if isplain | ||
| 149 | (car handles) | ||
| 150 | (if ismultipart | ||
| 151 | (car (cadadr handles)) | ||
| 152 | (caadr handles)))) | ||
| 153 | (decrypted | ||
| 154 | (with-current-buffer plainbuf (buffer-string))) | ||
| 155 | (gnus-info | ||
| 156 | (if isplain | ||
| 157 | nil | ||
| 158 | (if ismultipart | ||
| 159 | (or (mm-handle-multipart-ctl-parameter | ||
| 160 | (cadr handles) 'gnus-details) | ||
| 161 | (mm-handle-multipart-ctl-parameter | ||
| 162 | (cadr handles) 'gnus-info)) | ||
| 163 | (mm-handle-multipart-ctl-parameter | ||
| 164 | handles 'gnus-info))))) | ||
| 165 | (funcall body2 gnus-info plaintext decrypted))))) | ||
| 166 | interactive)) | ||
| 167 | |||
| 168 | ;; TODO If the variable BODY3 is renamed to BODY, an infinite recursion | ||
| 169 | ;; occurs. Emacs bug? | ||
| 170 | (defun mml-secure-test-key-fixture (body3) | ||
| 171 | "Customize unique keys for sub@example.org and call BODY3. | ||
| 172 | For OpenPGP, we have: | ||
| 173 | - 1E6B FA97 3D9E 3103 B77F D399 C399 9CF1 268D BEA2 | ||
| 174 | uid Different subkeys <sub@example.org> | ||
| 175 | - 1463 2ECA B9E2 2736 9C8D D97B F7E7 9AB7 AE31 D471 | ||
| 176 | uid Second Key Pair <sub@example.org> | ||
| 177 | |||
| 178 | For S/MIME: | ||
| 179 | ID: 0x479DC6E2 | ||
| 180 | Subject: /CN=Second Key Pair | ||
| 181 | aka: sub@example.org | ||
| 182 | fingerprint: 0E:58:22:9B:80:EE:33:95:9F:F7:18:FE:EF:25:40:2B:47:9D:C6:E2 | ||
| 183 | |||
| 184 | ID: 0x5F88E9FC | ||
| 185 | Subject: /CN=Different subkeys | ||
| 186 | aka: sub@example.org | ||
| 187 | fingerprint: 4F:96:2A:B7:F4:76:61:6A:78:3D:72:AA:40:35:D5:9B:5F:88:E9:FC | ||
| 188 | |||
| 189 | In both cases, the first key is customized for signing and encryption." | ||
| 190 | (mml-secure-test-fixture | ||
| 191 | (lambda () | ||
| 192 | (let* ((mml-secure-key-preferences | ||
| 193 | '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))) | ||
| 194 | (pcontext (epg-make-context 'OpenPGP)) | ||
| 195 | (pkey (epg-list-keys pcontext "C3999CF1268DBEA2")) | ||
| 196 | (scontext (epg-make-context 'CMS)) | ||
| 197 | (skey (epg-list-keys scontext "0x479DC6E2"))) | ||
| 198 | (mml-secure-cust-record-keys pcontext 'encrypt "sub@example.org" pkey) | ||
| 199 | (mml-secure-cust-record-keys pcontext 'sign "sub@example.org" pkey) | ||
| 200 | (mml-secure-cust-record-keys scontext 'encrypt "sub@example.org" skey) | ||
| 201 | (mml-secure-cust-record-keys scontext 'sign "sub@example.org" skey) | ||
| 202 | (funcall body3))))) | ||
| 203 | |||
| 204 | (ert-deftest mml-secure-key-checks () | ||
| 205 | "Test mml-secure-check-user-id and mml-secure-check-sub-key on sample keys." | ||
| 206 | (skip-unless (test-conf)) | ||
| 207 | (mml-secure-test-fixture | ||
| 208 | (lambda () | ||
| 209 | (let* ((context (epg-make-context 'OpenPGP)) | ||
| 210 | (keys1 (epg-list-keys context "expired@example.org")) | ||
| 211 | (keys2 (epg-list-keys context "no-exp@example.org")) | ||
| 212 | (keys3 (epg-list-keys context "sub@example.org")) | ||
| 213 | (keys4 (epg-list-keys context "revoked-uid@example.org")) | ||
| 214 | (keys5 (epg-list-keys context "disabled@example.org")) | ||
| 215 | (keys6 (epg-list-keys context "sign@example.org")) | ||
| 216 | (keys7 (epg-list-keys context "jens.lechtenboerger@fsfe")) | ||
| 217 | ) | ||
| 218 | (should (and (= 1 (length keys1)) (= 1 (length keys2)) | ||
| 219 | (= 2 (length keys3)) | ||
| 220 | (= 1 (length keys4)) (= 1 (length keys5)) | ||
| 221 | )) | ||
| 222 | ;; key1 is expired | ||
| 223 | (should-not (mml-secure-check-user-id (car keys1) "expired@example.org")) | ||
| 224 | (should-not (mml-secure-check-sub-key context (car keys1) 'encrypt)) | ||
| 225 | (should-not (mml-secure-check-sub-key context (car keys1) 'sign)) | ||
| 226 | |||
| 227 | ;; key2 does not expire, but does not have the UID expired@example.org | ||
| 228 | (should-not (mml-secure-check-user-id (car keys2) "expired@example.org")) | ||
| 229 | (should (mml-secure-check-user-id (car keys2) "no-exp@example.org")) | ||
| 230 | (should (mml-secure-check-sub-key context (car keys2) 'encrypt)) | ||
| 231 | (should (mml-secure-check-sub-key context (car keys2) 'sign)) | ||
| 232 | |||
| 233 | ;; Two keys exist for sub@example.org. | ||
| 234 | (should (mml-secure-check-user-id (car keys3) "sub@example.org")) | ||
| 235 | (should (mml-secure-check-sub-key context (car keys3) 'encrypt)) | ||
| 236 | (should (mml-secure-check-sub-key context (car keys3) 'sign)) | ||
| 237 | (should (mml-secure-check-user-id (cadr keys3) "sub@example.org")) | ||
| 238 | (should (mml-secure-check-sub-key context (cadr keys3) 'encrypt)) | ||
| 239 | (should (mml-secure-check-sub-key context (cadr keys3) 'sign)) | ||
| 240 | |||
| 241 | ;; The UID revoked-uid@example.org is revoked. The key itself is | ||
| 242 | ;; usable, though (with the UID sub@example.org). | ||
| 243 | (should-not | ||
| 244 | (mml-secure-check-user-id (car keys4) "revoked-uid@example.org")) | ||
| 245 | (should (mml-secure-check-sub-key context (car keys4) 'encrypt)) | ||
| 246 | (should (mml-secure-check-sub-key context (car keys4) 'sign)) | ||
| 247 | (should (mml-secure-check-user-id (car keys4) "sub@example.org")) | ||
| 248 | |||
| 249 | ;; The next key is disabled and, thus, unusable. | ||
| 250 | (should (mml-secure-check-user-id (car keys5) "disabled@example.org")) | ||
| 251 | (should-not (mml-secure-check-sub-key context (car keys5) 'encrypt)) | ||
| 252 | (should-not (mml-secure-check-sub-key context (car keys5) 'sign)) | ||
| 253 | |||
| 254 | ;; The next key has multiple subkeys. | ||
| 255 | ;; 42466F0F is valid sign subkey, 501FFD98 is expired | ||
| 256 | (should (mml-secure-check-sub-key context (car keys6) 'sign "42466F0F")) | ||
| 257 | (should-not | ||
| 258 | (mml-secure-check-sub-key context (car keys6) 'sign "501FFD98")) | ||
| 259 | ;; DC7F66E7 is encrypt subkey | ||
| 260 | (should | ||
| 261 | (mml-secure-check-sub-key context (car keys6) 'encrypt "DC7F66E7")) | ||
| 262 | (should-not | ||
| 263 | (mml-secure-check-sub-key context (car keys6) 'sign "DC7F66E7")) | ||
| 264 | (should-not | ||
| 265 | (mml-secure-check-sub-key context (car keys6) 'encrypt "42466F0F")) | ||
| 266 | |||
| 267 | ;; The final key is just a public key. | ||
| 268 | (should (mml-secure-check-sub-key context (car keys7) 'encrypt)) | ||
| 269 | (should-not (mml-secure-check-sub-key context (car keys7) 'sign)) | ||
| 270 | )))) | ||
| 271 | |||
| 272 | (ert-deftest mml-secure-find-usable-keys-1 () | ||
| 273 | "Make sure that expired and disabled keys and revoked UIDs are not used." | ||
| 274 | (skip-unless (test-conf)) | ||
| 275 | (mml-secure-test-fixture | ||
| 276 | (lambda () | ||
| 277 | (let ((context (epg-make-context 'OpenPGP))) | ||
| 278 | (should-not | ||
| 279 | (mml-secure-find-usable-keys context "expired@example.org" 'encrypt)) | ||
| 280 | (should-not | ||
| 281 | (mml-secure-find-usable-keys context "expired@example.org" 'sign)) | ||
| 282 | |||
| 283 | (should-not | ||
| 284 | (mml-secure-find-usable-keys context "disabled@example.org" 'encrypt)) | ||
| 285 | (should-not | ||
| 286 | (mml-secure-find-usable-keys context "disabled@example.org" 'sign)) | ||
| 287 | |||
| 288 | (should-not | ||
| 289 | (mml-secure-find-usable-keys | ||
| 290 | context "<revoked-uid@example.org>" 'encrypt)) | ||
| 291 | (should-not | ||
| 292 | (mml-secure-find-usable-keys | ||
| 293 | context "<revoked-uid@example.org>" 'sign)) | ||
| 294 | ;; Same test without ankles. Will fail for Ma Gnus v0.14 and earlier. | ||
| 295 | (should-not | ||
| 296 | (mml-secure-find-usable-keys | ||
| 297 | context "revoked-uid@example.org" 'encrypt)) | ||
| 298 | |||
| 299 | ;; Expired key should not be usable. | ||
| 300 | ;; Will fail for Ma Gnus v0.14 and earlier. | ||
| 301 | ;; sign@example.org has the expired subkey 0x501FFD98. | ||
| 302 | (should-not | ||
| 303 | (mml-secure-find-usable-keys context "0x501FFD98" 'sign)) | ||
| 304 | |||
| 305 | (should | ||
| 306 | (mml-secure-find-usable-keys context "no-exp@example.org" 'encrypt)) | ||
| 307 | (should | ||
| 308 | (mml-secure-find-usable-keys context "no-exp@example.org" 'sign)) | ||
| 309 | )))) | ||
| 310 | |||
| 311 | (ert-deftest mml-secure-find-usable-keys-2 () | ||
| 312 | "Test different ways to search for keys." | ||
| 313 | (skip-unless (test-conf)) | ||
| 314 | (mml-secure-test-fixture | ||
| 315 | (lambda () | ||
| 316 | (let ((context (epg-make-context 'OpenPGP))) | ||
| 317 | ;; Plain substring search is not supported. | ||
| 318 | (should | ||
| 319 | (= 0 (length | ||
| 320 | (mml-secure-find-usable-keys context "No Expiry" 'encrypt)))) | ||
| 321 | (should | ||
| 322 | (= 0 (length | ||
| 323 | (mml-secure-find-usable-keys context "No Expiry" 'sign)))) | ||
| 324 | |||
| 325 | ;; Search for e-mail addresses works with and without ankle brackets. | ||
| 326 | (should | ||
| 327 | (= 1 (length (mml-secure-find-usable-keys | ||
| 328 | context "<no-exp@example.org>" 'encrypt)))) | ||
| 329 | (should | ||
| 330 | (= 1 (length (mml-secure-find-usable-keys | ||
| 331 | context "<no-exp@example.org>" 'sign)))) | ||
| 332 | (should | ||
| 333 | (= 1 (length (mml-secure-find-usable-keys | ||
| 334 | context "no-exp@example.org" 'encrypt)))) | ||
| 335 | (should | ||
| 336 | (= 1 (length (mml-secure-find-usable-keys | ||
| 337 | context "no-exp@example.org" 'sign)))) | ||
| 338 | |||
| 339 | ;; Use full UID string. | ||
| 340 | (should | ||
| 341 | (= 1 (length (mml-secure-find-usable-keys | ||
| 342 | context "No Expiry <no-exp@example.org>" 'encrypt)))) | ||
| 343 | (should | ||
| 344 | (= 1 (length (mml-secure-find-usable-keys | ||
| 345 | context "No Expiry <no-exp@example.org>" 'sign)))) | ||
| 346 | |||
| 347 | ;; If just the public key is present, only encryption is possible. | ||
| 348 | ;; Search works with key IDs, with and without prefix "0x". | ||
| 349 | (should | ||
| 350 | (= 1 (length (mml-secure-find-usable-keys | ||
| 351 | context "A142FD84" 'encrypt)))) | ||
| 352 | (should | ||
| 353 | (= 1 (length (mml-secure-find-usable-keys | ||
| 354 | context "0xA142FD84" 'encrypt)))) | ||
| 355 | (should | ||
| 356 | (= 0 (length (mml-secure-find-usable-keys | ||
| 357 | context "A142FD84" 'sign)))) | ||
| 358 | (should | ||
| 359 | (= 0 (length (mml-secure-find-usable-keys | ||
| 360 | context "0xA142FD84" 'sign)))) | ||
| 361 | )))) | ||
| 362 | |||
| 363 | (ert-deftest mml-secure-select-preferred-keys-1 () | ||
| 364 | "If only one key exists for an e-mail address, it is the preferred one." | ||
| 365 | (skip-unless (test-conf)) | ||
| 366 | (mml-secure-test-fixture | ||
| 367 | (lambda () | ||
| 368 | (let ((context (epg-make-context 'OpenPGP))) | ||
| 369 | (should (equal "832F3CC6518D37BC658261B802372A42CA6D40FB" | ||
| 370 | (mml-secure-fingerprint | ||
| 371 | (car (mml-secure-select-preferred-keys | ||
| 372 | context '("no-exp@example.org") 'encrypt))))))))) | ||
| 373 | |||
| 374 | (ert-deftest mml-secure-select-preferred-keys-2 () | ||
| 375 | "If multiple keys exists for an e-mail address, customization is necessary." | ||
| 376 | (skip-unless (test-conf)) | ||
| 377 | (mml-secure-test-fixture | ||
| 378 | (lambda () | ||
| 379 | (let* ((context (epg-make-context 'OpenPGP)) | ||
| 380 | (mml-secure-key-preferences | ||
| 381 | '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))) | ||
| 382 | (pref (car (mml-secure-find-usable-keys | ||
| 383 | context "sub@example.org" 'encrypt)))) | ||
| 384 | (should-error (mml-secure-select-preferred-keys | ||
| 385 | context '("sub@example.org") 'encrypt)) | ||
| 386 | (mml-secure-cust-record-keys | ||
| 387 | context 'encrypt "sub@example.org" (list pref)) | ||
| 388 | (should (mml-secure-select-preferred-keys | ||
| 389 | context '("sub@example.org") 'encrypt)) | ||
| 390 | (should-error (mml-secure-select-preferred-keys | ||
| 391 | context '("sub@example.org") 'sign)) | ||
| 392 | (should (mml-secure-select-preferred-keys | ||
| 393 | context '("sub@example.org") 'encrypt)) | ||
| 394 | (should | ||
| 395 | (equal (list (mml-secure-fingerprint pref)) | ||
| 396 | (mml-secure-cust-fpr-lookup context 'encrypt "sub@example.org"))) | ||
| 397 | (should (mml-secure-cust-remove-keys context 'encrypt "sub@example.org")) | ||
| 398 | (should-error (mml-secure-select-preferred-keys | ||
| 399 | context '("sub@example.org") 'encrypt)))))) | ||
| 400 | |||
| 401 | (ert-deftest mml-secure-select-preferred-keys-3 () | ||
| 402 | "Expired customized keys are removed if multiple keys are available." | ||
| 403 | (skip-unless (test-conf)) | ||
| 404 | (mml-secure-test-fixture | ||
| 405 | (lambda () | ||
| 406 | (let ((context (epg-make-context 'OpenPGP)) | ||
| 407 | (mml-secure-key-preferences | ||
| 408 | '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))))) | ||
| 409 | ;; sub@example.org has two keys (268DBEA2, AE31D471). | ||
| 410 | ;; Normal preference works. | ||
| 411 | (mml-secure-cust-record-keys | ||
| 412 | context 'encrypt "sub@example.org" (epg-list-keys context "268DBEA2")) | ||
| 413 | (should (mml-secure-select-preferred-keys | ||
| 414 | context '("sub@example.org") 'encrypt)) | ||
| 415 | (mml-secure-cust-remove-keys context 'encrypt "sub@example.org") | ||
| 416 | |||
| 417 | ;; Fake preference for expired (unrelated) key CE15FAE7, | ||
| 418 | ;; results in error (and automatic removal of outdated preference). | ||
| 419 | (mml-secure-cust-record-keys | ||
| 420 | context 'encrypt "sub@example.org" (epg-list-keys context "CE15FAE7")) | ||
| 421 | (should-error (mml-secure-select-preferred-keys | ||
| 422 | context '("sub@example.org") 'encrypt)) | ||
| 423 | (should-not | ||
| 424 | (mml-secure-cust-remove-keys context 'encrypt "sub@example.org")))))) | ||
| 425 | |||
| 426 | (ert-deftest mml-secure-select-preferred-keys-4 () | ||
| 427 | "Multiple keys can be recorded per recipient or signature." | ||
| 428 | (skip-unless (test-conf)) | ||
| 429 | (mml-secure-test-fixture | ||
| 430 | (lambda () | ||
| 431 | (let ((pcontext (epg-make-context 'OpenPGP)) | ||
| 432 | (scontext (epg-make-context 'CMS)) | ||
| 433 | (pkeys '("1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" | ||
| 434 | "14632ECAB9E227369C8DD97BF7E79AB7AE31D471")) | ||
| 435 | (skeys '("0x5F88E9FC" "0x479DC6E2")) | ||
| 436 | (mml-secure-key-preferences | ||
| 437 | '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt))))) | ||
| 438 | |||
| 439 | ;; OpenPGP preferences via pcontext | ||
| 440 | (dolist (key pkeys nil) | ||
| 441 | (mml-secure-cust-record-keys | ||
| 442 | pcontext 'encrypt "sub@example.org" (epg-list-keys pcontext key)) | ||
| 443 | (mml-secure-cust-record-keys | ||
| 444 | pcontext 'sign "sub@example.org" (epg-list-keys pcontext key 'secret))) | ||
| 445 | (let ((p-e-fprs (mml-secure-cust-fpr-lookup | ||
| 446 | pcontext 'encrypt "sub@example.org")) | ||
| 447 | (p-s-fprs (mml-secure-cust-fpr-lookup | ||
| 448 | pcontext 'sign "sub@example.org"))) | ||
| 449 | (should (= 2 (length p-e-fprs))) | ||
| 450 | (should (= 2 (length p-s-fprs))) | ||
| 451 | (should (member "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" p-e-fprs)) | ||
| 452 | (should (member "14632ECAB9E227369C8DD97BF7E79AB7AE31D471" p-e-fprs)) | ||
| 453 | (should (member "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2" p-s-fprs)) | ||
| 454 | (should (member "14632ECAB9E227369C8DD97BF7E79AB7AE31D471" p-s-fprs))) | ||
| 455 | ;; Duplicate record does not change anything. | ||
| 456 | (mml-secure-cust-record-keys | ||
| 457 | pcontext 'encrypt "sub@example.org" | ||
| 458 | (epg-list-keys pcontext "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2")) | ||
| 459 | (mml-secure-cust-record-keys | ||
| 460 | pcontext 'sign "sub@example.org" | ||
| 461 | (epg-list-keys pcontext "1E6BFA973D9E3103B77FD399C3999CF1268DBEA2")) | ||
| 462 | (let ((p-e-fprs (mml-secure-cust-fpr-lookup | ||
| 463 | pcontext 'encrypt "sub@example.org")) | ||
| 464 | (p-s-fprs (mml-secure-cust-fpr-lookup | ||
| 465 | pcontext 'sign "sub@example.org"))) | ||
| 466 | (should (= 2 (length p-e-fprs))) | ||
| 467 | (should (= 2 (length p-s-fprs)))) | ||
| 468 | |||
| 469 | ;; S/MIME preferences via scontext | ||
| 470 | (dolist (key skeys nil) | ||
| 471 | (mml-secure-cust-record-keys | ||
| 472 | scontext 'encrypt "sub@example.org" | ||
| 473 | (epg-list-keys scontext key)) | ||
| 474 | (mml-secure-cust-record-keys | ||
| 475 | scontext 'sign "sub@example.org" | ||
| 476 | (epg-list-keys scontext key 'secret))) | ||
| 477 | (let ((s-e-fprs (mml-secure-cust-fpr-lookup | ||
| 478 | scontext 'encrypt "sub@example.org")) | ||
| 479 | (s-s-fprs (mml-secure-cust-fpr-lookup | ||
| 480 | scontext 'sign "sub@example.org"))) | ||
| 481 | (should (= 2 (length s-e-fprs))) | ||
| 482 | (should (= 2 (length s-s-fprs)))) | ||
| 483 | )))) | ||
| 484 | |||
| 485 | (defun mml-secure-test-en-decrypt | ||
| 486 | (method to from | ||
| 487 | &optional checksig checkplain enc-keys expectfail interactive) | ||
| 488 | "Encrypt message using METHOD, addressed to TO, from FROM. | ||
| 489 | If optional CHECKSIG is non-nil, it must be a number, and a signature check is | ||
| 490 | performed; the number indicates how many signatures are expected. | ||
| 491 | If optional CHECKPLAIN is non-nil, the expected plaintext should be obtained | ||
| 492 | via decryption. | ||
| 493 | If optional ENC-KEYS is non-nil, it is a list of pairs of encryption keys (for | ||
| 494 | OpenPGP and S/SMIME) expected in `epg-debug-buffer'. | ||
| 495 | If optional EXPECTFAIL is non-nil, a decryption failure is expected. | ||
| 496 | Pass optional INTERACTIVE to mml-secure-test-mail-fixture." | ||
| 497 | (mml-secure-test-mail-fixture method to from | ||
| 498 | (lambda (gnus-info plaintext decrypted) | ||
| 499 | (if expectfail | ||
| 500 | (should-not (equal plaintext decrypted)) | ||
| 501 | (when checkplain | ||
| 502 | (should (equal plaintext decrypted))) | ||
| 503 | (let ((protocol (if (memq method | ||
| 504 | '(enc-smime enc-sign-smime sign-smime)) | ||
| 505 | 'CMS | ||
| 506 | 'OpenPGP))) | ||
| 507 | (when checksig | ||
| 508 | (let* ((context (epg-make-context protocol)) | ||
| 509 | (signer-names (mml-secure-signer-names protocol from)) | ||
| 510 | (signer-keys (mml-secure-signers context signer-names)) | ||
| 511 | (signer-fprs (mapcar 'mml-secure-fingerprint signer-keys))) | ||
| 512 | (should (eq checksig (length signer-fprs))) | ||
| 513 | (if (eq checksig 0) | ||
| 514 | ;; First key in keyring | ||
| 515 | (should (string-match-p | ||
| 516 | (concat "Good signature from " | ||
| 517 | (if (eq protocol 'CMS) | ||
| 518 | "0E58229B80EE33959FF718FEEF25402B479DC6E2" | ||
| 519 | "02372A42CA6D40FB")) | ||
| 520 | gnus-info))) | ||
| 521 | (dolist (fpr signer-fprs nil) | ||
| 522 | ;; OpenPGP: "Good signature from 02372A42CA6D40FB No Expiry <no-exp@example.org> (trust undefined) created ..." | ||
| 523 | ;; S/MIME: "Good signature from D06AA118653CC38E9D0CAF56ED7A2135E1582177 /CN=No Expiry (trust full) ..." | ||
| 524 | (should (string-match-p | ||
| 525 | (concat "Good signature from " | ||
| 526 | (if (eq protocol 'CMS) | ||
| 527 | fpr | ||
| 528 | (substring fpr -16 nil))) | ||
| 529 | gnus-info))))) | ||
| 530 | (when enc-keys | ||
| 531 | (with-current-buffer epg-debug-buffer | ||
| 532 | (goto-char (point-min)) | ||
| 533 | ;; The following regexp does not necessarily match at the | ||
| 534 | ;; start of the line as a path may or may not be present. | ||
| 535 | ;; Also note that gpg.* matches gpg2 and gpgsm as well. | ||
| 536 | (let* ((line (concat "gpg.*--encrypt.*$")) | ||
| 537 | (end (re-search-forward line)) | ||
| 538 | (match (match-string 0))) | ||
| 539 | (should (and end match)) | ||
| 540 | (dolist (pair enc-keys nil) | ||
| 541 | (let ((fpr (if (eq protocol 'OpenPGP) | ||
| 542 | (car pair) | ||
| 543 | (cdr pair)))) | ||
| 544 | (should (string-match-p (concat "-r " fpr) match)))) | ||
| 545 | (goto-char (point-max)) | ||
| 546 | )))))) | ||
| 547 | interactive)) | ||
| 548 | |||
| 549 | (defun mml-secure-test-en-decrypt-with-passphrase | ||
| 550 | (method to from checksig jl-passphrase do-cache | ||
| 551 | &optional enc-keys expectfail) | ||
| 552 | "Call mml-secure-test-en-decrypt with changed passphrase caching. | ||
| 553 | Args METHOD, TO, FROM, CHECKSIG are passed to mml-secure-test-en-decrypt. | ||
| 554 | JL-PASSPHRASE is fixed as return value for `read-passwd', | ||
| 555 | boolean DO-CACHE determines whether to cache the passphrase. | ||
| 556 | If optional ENC-KEYS is non-nil, it is a list of encryption keys expected | ||
| 557 | in `epg-debug-buffer'. | ||
| 558 | If optional EXPECTFAIL is non-nil, a decryption failure is expected." | ||
| 559 | (let ((mml-secure-cache-passphrase do-cache) | ||
| 560 | (mml1991-cache-passphrase do-cache) | ||
| 561 | (mml2015-cache-passphrase do-cache) | ||
| 562 | (mml-smime-cache-passphrase do-cache) | ||
| 563 | ) | ||
| 564 | (cl-letf (((symbol-function 'read-passwd) | ||
| 565 | (lambda (prompt &optional confirm default) jl-passphrase))) | ||
| 566 | (mml-secure-test-en-decrypt method to from checksig t enc-keys expectfail) | ||
| 567 | ))) | ||
| 568 | |||
| 569 | (ert-deftest mml-secure-en-decrypt-1 () | ||
| 570 | "Encrypt message; then decrypt and test for expected result. | ||
| 571 | In this test, the single matching key is chosen automatically." | ||
| 572 | (skip-unless (test-conf)) | ||
| 573 | (dolist (method (enc-standards) nil) | ||
| 574 | ;; no-exp@example.org with single encryption key | ||
| 575 | (mml-secure-test-en-decrypt | ||
| 576 | method "no-exp@example.org" "sub@example.org" nil t | ||
| 577 | (list (cons "02372A42CA6D40FB" "ED7A2135E1582177"))))) | ||
| 578 | |||
| 579 | (ert-deftest mml-secure-en-decrypt-2 () | ||
| 580 | "Encrypt message; then decrypt and test for expected result. | ||
| 581 | In this test, the encryption key needs to fixed among multiple ones." | ||
| 582 | (skip-unless (test-conf)) | ||
| 583 | ;; sub@example.org with multiple candidate keys, | ||
| 584 | ;; fixture customizes preferred ones. | ||
| 585 | (mml-secure-test-key-fixture | ||
| 586 | (lambda () | ||
| 587 | (dolist (method (enc-standards) nil) | ||
| 588 | (mml-secure-test-en-decrypt | ||
| 589 | method "sub@example.org" "no-exp@example.org" nil t | ||
| 590 | (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2"))))))) | ||
| 591 | |||
| 592 | (ert-deftest mml-secure-en-decrypt-3 () | ||
| 593 | "Encrypt message; then decrypt and test for expected result. | ||
| 594 | In this test, encrypt-to-self variables are set to t." | ||
| 595 | (skip-unless (test-conf)) | ||
| 596 | ;; sub@example.org with multiple candidate keys, | ||
| 597 | ;; fixture customizes preferred ones. | ||
| 598 | (mml-secure-test-key-fixture | ||
| 599 | (lambda () | ||
| 600 | (let ((mml-secure-openpgp-encrypt-to-self t) | ||
| 601 | (mml-secure-smime-encrypt-to-self t)) | ||
| 602 | (dolist (method (enc-standards) nil) | ||
| 603 | (mml-secure-test-en-decrypt | ||
| 604 | method "sub@example.org" "no-exp@example.org" nil t | ||
| 605 | (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2") | ||
| 606 | (cons "02372A42CA6D40FB" "ED7A2135E1582177")))))))) | ||
| 607 | |||
| 608 | (ert-deftest mml-secure-en-decrypt-4 () | ||
| 609 | "Encrypt message; then decrypt and test for expected result. | ||
| 610 | In this test, encrypt-to-self variables are set to lists." | ||
| 611 | (skip-unless (test-conf)) | ||
| 612 | ;; Send from sub@example.org, which has two keys; encrypt to both. | ||
| 613 | (let ((mml-secure-openpgp-encrypt-to-self | ||
| 614 | '("C3999CF1268DBEA2" "F7E79AB7AE31D471")) | ||
| 615 | (mml-secure-smime-encrypt-to-self | ||
| 616 | '("EF25402B479DC6E2" "4035D59B5F88E9FC"))) | ||
| 617 | (dolist (method (enc-standards) nil) | ||
| 618 | (mml-secure-test-en-decrypt | ||
| 619 | method "no-exp@example.org" "sub@example.org" nil t | ||
| 620 | (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2") | ||
| 621 | (cons "F7E79AB7AE31D471" "4035D59B5F88E9FC")))))) | ||
| 622 | |||
| 623 | (ert-deftest mml-secure-en-decrypt-sign-1-1-single () | ||
| 624 | "Sign and encrypt message; then decrypt and test for expected result. | ||
| 625 | In this test, just multiple encryption and signing keys may be available." | ||
| 626 | :tags '(:unstable) | ||
| 627 | (skip-unless (test-conf)) | ||
| 628 | (mml-secure-test-key-fixture | ||
| 629 | (lambda () | ||
| 630 | (let ((mml-secure-openpgp-sign-with-sender t) | ||
| 631 | (mml-secure-smime-sign-with-sender t)) | ||
| 632 | (dolist (method (enc-sign-standards) nil) | ||
| 633 | ;; no-exp with just one key | ||
| 634 | (mml-secure-test-en-decrypt | ||
| 635 | method "no-exp@example.org" "no-exp@example.org" 1 t) | ||
| 636 | ;; customized choice for encryption key | ||
| 637 | (mml-secure-test-en-decrypt | ||
| 638 | method "sub@example.org" "no-exp@example.org" 1 t) | ||
| 639 | ;; customized choice for signing key | ||
| 640 | (mml-secure-test-en-decrypt | ||
| 641 | method "no-exp@example.org" "sub@example.org" 1 t) | ||
| 642 | ;; customized choice for both keys | ||
| 643 | (mml-secure-test-en-decrypt | ||
| 644 | method "sub@example.org" "sub@example.org" 1 t) | ||
| 645 | ))))) | ||
| 646 | |||
| 647 | (ert-deftest mml-secure-en-decrypt-sign-1-2-double () | ||
| 648 | "Sign and encrypt message; then decrypt and test for expected result. | ||
| 649 | In this test, just multiple encryption and signing keys may be available." | ||
| 650 | (skip-unless (test-conf)) | ||
| 651 | (mml-secure-test-key-fixture | ||
| 652 | (lambda () | ||
| 653 | (let ((mml-secure-openpgp-sign-with-sender t) | ||
| 654 | (mml-secure-smime-sign-with-sender t)) | ||
| 655 | ;; Now use both keys to sign. The customized one via sign-with-sender, | ||
| 656 | ;; the other one via the following setting. | ||
| 657 | (let ((mml-secure-openpgp-signers '("F7E79AB7AE31D471")) | ||
| 658 | (mml-secure-smime-signers '("0x5F88E9FC"))) | ||
| 659 | (dolist (method (enc-sign-standards) nil) | ||
| 660 | (mml-secure-test-en-decrypt | ||
| 661 | method "no-exp@example.org" "sub@example.org" 2 t))))))) | ||
| 662 | |||
| 663 | (ert-deftest mml-secure-en-decrypt-sign-1-3-double () | ||
| 664 | "Sign and encrypt message; then decrypt and test for expected result. | ||
| 665 | In this test, just multiple encryption and signing keys may be available." | ||
| 666 | (skip-unless (test-conf)) | ||
| 667 | (mml-secure-test-key-fixture | ||
| 668 | (lambda () | ||
| 669 | ;; Now use both keys for sub@example.org to sign an e-mail from | ||
| 670 | ;; a different address (without associated keys). | ||
| 671 | (let ((mml-secure-openpgp-sign-with-sender nil) | ||
| 672 | (mml-secure-smime-sign-with-sender nil) | ||
| 673 | (mml-secure-openpgp-signers | ||
| 674 | '("F7E79AB7AE31D471" "C3999CF1268DBEA2")) | ||
| 675 | (mml-secure-smime-signers '("0x5F88E9FC" "0x479DC6E2"))) | ||
| 676 | (dolist (method (enc-sign-standards) nil) | ||
| 677 | (mml-secure-test-en-decrypt | ||
| 678 | method "no-exp@example.org" "no-keys@example.org" 2 t)))))) | ||
| 679 | |||
| 680 | (ert-deftest mml-secure-en-decrypt-sign-2 () | ||
| 681 | "Sign and encrypt message; then decrypt and test for expected result. | ||
| 682 | In this test, lists of encryption and signing keys are customized." | ||
| 683 | (skip-unless (test-conf)) | ||
| 684 | (mml-secure-test-key-fixture | ||
| 685 | (lambda () | ||
| 686 | (let ((mml-secure-key-preferences | ||
| 687 | '((OpenPGP (sign) (encrypt)) (CMS (sign) (encrypt)))) | ||
| 688 | (pcontext (epg-make-context 'OpenPGP)) | ||
| 689 | (scontext (epg-make-context 'CMS)) | ||
| 690 | (mml-secure-openpgp-sign-with-sender t) | ||
| 691 | (mml-secure-smime-sign-with-sender t)) | ||
| 692 | (dolist (key '("F7E79AB7AE31D471" "C3999CF1268DBEA2") nil) | ||
| 693 | (mml-secure-cust-record-keys | ||
| 694 | pcontext 'encrypt "sub@example.org" (epg-list-keys pcontext key)) | ||
| 695 | (mml-secure-cust-record-keys | ||
| 696 | pcontext 'sign "sub@example.org" (epg-list-keys pcontext key t))) | ||
| 697 | (dolist (key '("0x5F88E9FC" "0x479DC6E2") nil) | ||
| 698 | (mml-secure-cust-record-keys | ||
| 699 | scontext 'encrypt "sub@example.org" (epg-list-keys scontext key)) | ||
| 700 | (mml-secure-cust-record-keys | ||
| 701 | scontext 'sign "sub@example.org" (epg-list-keys scontext key t))) | ||
| 702 | (dolist (method (enc-sign-standards) nil) | ||
| 703 | ;; customized choice for encryption key | ||
| 704 | (mml-secure-test-en-decrypt | ||
| 705 | method "sub@example.org" "no-exp@example.org" 1 t) | ||
| 706 | ;; customized choice for signing key | ||
| 707 | (mml-secure-test-en-decrypt | ||
| 708 | method "no-exp@example.org" "sub@example.org" 2 t) | ||
| 709 | ;; customized choice for both keys | ||
| 710 | (mml-secure-test-en-decrypt | ||
| 711 | method "sub@example.org" "sub@example.org" 2 t) | ||
| 712 | ))))) | ||
| 713 | |||
| 714 | (ert-deftest mml-secure-en-decrypt-sign-3 () | ||
| 715 | "Sign and encrypt message; then decrypt and test for expected result. | ||
| 716 | Use sign-with-sender and encrypt-to-self." | ||
| 717 | (skip-unless (test-conf)) | ||
| 718 | (mml-secure-test-key-fixture | ||
| 719 | (lambda () | ||
| 720 | (let ((mml-secure-openpgp-sign-with-sender t) | ||
| 721 | (mml-secure-openpgp-encrypt-to-self t) | ||
| 722 | (mml-secure-smime-sign-with-sender t) | ||
| 723 | (mml-secure-smime-encrypt-to-self t)) | ||
| 724 | (dolist (method (enc-sign-standards) nil) | ||
| 725 | (mml-secure-test-en-decrypt | ||
| 726 | method "sub@example.org" "no-exp@example.org" 1 t | ||
| 727 | (list (cons "C3999CF1268DBEA2" "EF25402B479DC6E2") | ||
| 728 | (cons "02372A42CA6D40FB" "ED7A2135E1582177")))) | ||
| 729 | )))) | ||
| 730 | |||
| 731 | (ert-deftest mml-secure-sign-verify-1 () | ||
| 732 | "Sign message with sender; then verify and test for expected result." | ||
| 733 | (skip-unless (test-conf)) | ||
| 734 | (mml-secure-test-key-fixture | ||
| 735 | (lambda () | ||
| 736 | (dolist (method (sign-standards) nil) | ||
| 737 | (let ((mml-secure-openpgp-sign-with-sender t) | ||
| 738 | (mml-secure-smime-sign-with-sender t)) | ||
| 739 | ;; A single signing key for sender sub@example.org is customized | ||
| 740 | ;; in the fixture. | ||
| 741 | (mml-secure-test-en-decrypt | ||
| 742 | method "uid1@example.org" "sub@example.org" 1 nil) | ||
| 743 | |||
| 744 | ;; From sub@example.org, sign with two keys; | ||
| 745 | ;; sign-with-sender and one from signers-variable: | ||
| 746 | (let ((mml-secure-openpgp-signers '("02372A42CA6D40FB")) | ||
| 747 | (mml-secure-smime-signers | ||
| 748 | '("D06AA118653CC38E9D0CAF56ED7A2135E1582177"))) | ||
| 749 | (mml-secure-test-en-decrypt | ||
| 750 | method "no-exp@example.org" "sub@example.org" 2 nil)) | ||
| 751 | ))))) | ||
| 752 | |||
| 753 | (ert-deftest mml-secure-sign-verify-2 () | ||
| 754 | "Sign message without sender; then verify and test for expected result." | ||
| 755 | (skip-unless (test-conf)) | ||
| 756 | (mml-secure-test-key-fixture | ||
| 757 | (lambda () | ||
| 758 | (dolist (method (sign-standards) nil) | ||
| 759 | (let ((mml-secure-openpgp-sign-with-sender nil) | ||
| 760 | (mml-secure-smime-sign-with-sender nil)) | ||
| 761 | ;; A single signing key for sender sub@example.org is customized | ||
| 762 | ;; in the fixture, but not used here. | ||
| 763 | ;; By default, gpg uses the first secret key in the keyring, which | ||
| 764 | ;; is 02372A42CA6D40FB (OpenPGP) or | ||
| 765 | ;; 0E58229B80EE33959FF718FEEF25402B479DC6E2 (S/MIME) here. | ||
| 766 | (mml-secure-test-en-decrypt | ||
| 767 | method "uid1@example.org" "sub@example.org" 0 nil) | ||
| 768 | |||
| 769 | ;; From sub@example.org, sign with specified key: | ||
| 770 | (let ((mml-secure-openpgp-signers '("02372A42CA6D40FB")) | ||
| 771 | (mml-secure-smime-signers | ||
| 772 | '("D06AA118653CC38E9D0CAF56ED7A2135E1582177"))) | ||
| 773 | (mml-secure-test-en-decrypt | ||
| 774 | method "no-exp@example.org" "sub@example.org" 1 nil)) | ||
| 775 | |||
| 776 | ;; From sub@example.org, sign with different specified key: | ||
| 777 | (let ((mml-secure-openpgp-signers '("C3999CF1268DBEA2")) | ||
| 778 | (mml-secure-smime-signers | ||
| 779 | '("0E58229B80EE33959FF718FEEF25402B479DC6E2"))) | ||
| 780 | (mml-secure-test-en-decrypt | ||
| 781 | method "no-exp@example.org" "sub@example.org" 1 nil)) | ||
| 782 | ))))) | ||
| 783 | |||
| 784 | (ert-deftest mml-secure-sign-verify-3 () | ||
| 785 | "Try to sign message with expired OpenPGP subkey, which raises an error. | ||
| 786 | With Ma Gnus v0.14 and earlier a signature would be created with a wrong key." | ||
| 787 | (skip-unless (test-conf)) | ||
| 788 | (should-error | ||
| 789 | (mml-secure-test-key-fixture | ||
| 790 | (lambda () | ||
| 791 | (let ((with-smime nil) | ||
| 792 | (mml-secure-openpgp-sign-with-sender nil) | ||
| 793 | (mml-secure-openpgp-signers '("501FFD98"))) | ||
| 794 | (dolist (method (sign-standards) nil) | ||
| 795 | (mml-secure-test-en-decrypt | ||
| 796 | method "no-exp@example.org" "sign@example.org" 1 nil) | ||
| 797 | )))))) | ||
| 798 | |||
| 799 | ;; TODO Passphrase passing and caching in Emacs does not seem to work | ||
| 800 | ;; with gpgsm at all. | ||
| 801 | ;; Independently of caching settings, a pinentry dialogue is displayed. | ||
| 802 | ;; Thus, the following tests require the user to enter the correct gpgsm | ||
| 803 | ;; passphrases at the correct points in time. (Either empty string or | ||
| 804 | ;; "Passphrase".) | ||
| 805 | (ert-deftest mml-secure-en-decrypt-passphrase-cache () | ||
| 806 | "Encrypt message; then decrypt and test for expected result. | ||
| 807 | In this test, a key is used that requires the passphrase \"Passphrase\". | ||
| 808 | In the first decryption this passphrase is hardcoded, in the second one it | ||
| 809 | is taken from a cache." | ||
| 810 | (skip-unless (test-conf)) | ||
| 811 | (ert-skip "Requires passphrase") | ||
| 812 | (mml-secure-test-key-fixture | ||
| 813 | (lambda () | ||
| 814 | (dolist (method (enc-standards) nil) | ||
| 815 | (mml-secure-test-en-decrypt-with-passphrase | ||
| 816 | method "uid1@example.org" "sub@example.org" nil | ||
| 817 | ;; Beware! For passphrases copy-sequence is necessary, as they may | ||
| 818 | ;; be erased, which actually changes the function's code and causes | ||
| 819 | ;; multiple invokations to fail. I was surprised... | ||
| 820 | (copy-sequence "Passphrase") t) | ||
| 821 | (mml-secure-test-en-decrypt-with-passphrase | ||
| 822 | method "uid1@example.org" "sub@example.org" nil | ||
| 823 | (copy-sequence "Incorrect") t))))) | ||
| 824 | |||
| 825 | (defun mml-secure-en-decrypt-passphrase-no-cache (method) | ||
| 826 | "Encrypt message with METHOD; then decrypt and test for expected result. | ||
| 827 | In this test, a key is used that requires the passphrase \"Passphrase\". | ||
| 828 | In the first decryption this passphrase is hardcoded, but caching disabled. | ||
| 829 | So the second decryption fails." | ||
| 830 | (mml-secure-test-key-fixture | ||
| 831 | (lambda () | ||
| 832 | (mml-secure-test-en-decrypt-with-passphrase | ||
| 833 | method "uid1@example.org" "sub@example.org" nil | ||
| 834 | (copy-sequence "Passphrase") nil) | ||
| 835 | (mml-secure-test-en-decrypt-with-passphrase | ||
| 836 | method "uid1@example.org" "sub@example.org" nil | ||
| 837 | (copy-sequence "Incorrect") nil nil t)))) | ||
| 838 | |||
| 839 | (ert-deftest mml-secure-en-decrypt-passphrase-no-cache-openpgp-todo () | ||
| 840 | "Passphrase caching with OpenPGP only for GnuPG 1.x." | ||
| 841 | (skip-unless (test-conf)) | ||
| 842 | (skip-unless (string< (cdr (assq 'version (epg-configuration))) "2")) | ||
| 843 | (mml-secure-en-decrypt-passphrase-no-cache 'enc-pgp) | ||
| 844 | (mml-secure-en-decrypt-passphrase-no-cache 'enc-pgp-mime)) | ||
| 845 | |||
| 846 | (ert-deftest mml-secure-en-decrypt-passphrase-no-cache-smime-todo () | ||
| 847 | "Passphrase caching does not work with S/MIME (and gpgsm)." | ||
| 848 | :expected-result :failed | ||
| 849 | (skip-unless (test-conf)) | ||
| 850 | (if with-smime | ||
| 851 | (mml-secure-en-decrypt-passphrase-no-cache 'enc-smime) | ||
| 852 | (should nil))) | ||
| 853 | |||
| 854 | |||
| 855 | ;; Test truncation of question in y-or-n-p. | ||
| 856 | (defun mml-secure-select-preferred-keys-todo () | ||
| 857 | "Manual customization with truncated question." | ||
| 858 | (mml-secure-test-key-fixture | ||
| 859 | (lambda () | ||
| 860 | (mml-secure-test-en-decrypt | ||
| 861 | 'enc-pgp-mime | ||
| 862 | "jens.lechtenboerger@informationelle-selbstbestimmung-im-internet.de" | ||
| 863 | "no-exp@example.org" nil t nil nil t)))) | ||
| 864 | |||
| 865 | (defun mml-secure-select-preferred-keys-ok () | ||
| 866 | "Manual customization with entire question." | ||
| 867 | (mml-secure-test-fixture | ||
| 868 | (lambda () | ||
| 869 | (mml-secure-select-preferred-keys | ||
| 870 | (epg-make-context 'OpenPGP) | ||
| 871 | '("jens.lechtenboerger@informationelle-selbstbestimmung-im-internet.de") | ||
| 872 | 'encrypt)) | ||
| 873 | t)) | ||
| 874 | |||
| 875 | |||
| 876 | ;; ERT entry points | ||
| 877 | (defun mml-secure-run-tests () | ||
| 878 | "Run all tests with defaults." | ||
| 879 | (ert-run-tests-batch)) | ||
| 880 | |||
| 881 | (defun mml-secure-run-tests-with-gpg2 () | ||
| 882 | "Run all tests with gpg2 instead of gpg." | ||
| 883 | (let* ((epg-gpg-program "gpg2"); ~/local/gnupg-2.1.9/PLAY/inst/bin/gpg2 | ||
| 884 | (gpg-version (cdr (assq 'version (epg-configuration)))) | ||
| 885 | ;; Empty passphrases do not seem to work with gpgsm in 2.1.x: | ||
| 886 | ;; https://lists.gnupg.org/pipermail/gnupg-users/2015-October/054575.html | ||
| 887 | (with-smime (string< gpg-version "2.1"))) | ||
| 888 | (ert-run-tests-batch))) | ||
| 889 | |||
| 890 | (defun mml-secure-run-tests-without-smime () | ||
| 891 | "Skip S/MIME tests (as they require manual passphrase entry)." | ||
| 892 | (let ((with-smime nil)) | ||
| 893 | (ert-run-tests-batch))) | ||
| 894 | |||
| 895 | ;;; gnustest-mml-sec.el ends here | ||
diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el new file mode 100644 index 00000000000..b2b27d2ae7b --- /dev/null +++ b/test/lisp/net/browse-url-tests.el | |||
| @@ -0,0 +1,119 @@ | |||
| 1 | ;;; browse-url-tests.el --- Tests for browse-url.el -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Simen Heggestøyl <simenheg@gmail.com> | ||
| 6 | ;; Keywords: | ||
| 7 | |||
| 8 | ;; This file is part of GNU Emacs. | ||
| 9 | |||
| 10 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 11 | ;; it under the terms of the GNU General Public License as published by | ||
| 12 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 13 | ;; (at your option) any later version. | ||
| 14 | |||
| 15 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 18 | ;; GNU General Public License for more details. | ||
| 19 | |||
| 20 | ;; You should have received a copy of the GNU General Public License | ||
| 21 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 22 | |||
| 23 | ;;; Commentary: | ||
| 24 | |||
| 25 | ;; | ||
| 26 | |||
| 27 | ;;; Code: | ||
| 28 | |||
| 29 | (require 'browse-url) | ||
| 30 | (require 'ert) | ||
| 31 | |||
| 32 | (ert-deftest browse-url-tests-browser-kind () | ||
| 33 | (should (eq (browse-url--browser-kind #'browse-url-w3 "gnu.org") | ||
| 34 | 'internal)) | ||
| 35 | (should | ||
| 36 | (eq (browse-url--browser-kind #'browse-url-firefox "gnu.org") | ||
| 37 | 'external))) | ||
| 38 | |||
| 39 | (ert-deftest browse-url-tests-non-html-file-url-p () | ||
| 40 | (should (browse-url--non-html-file-url-p "file://foo.txt")) | ||
| 41 | (should-not (browse-url--non-html-file-url-p "file://foo.html"))) | ||
| 42 | |||
| 43 | (ert-deftest browse-url-tests-select-handler-mailto () | ||
| 44 | (should (eq (browse-url-select-handler "mailto:foo@bar.org") | ||
| 45 | 'browse-url--mailto)) | ||
| 46 | (should (eq (browse-url-select-handler "mailto:foo@bar.org" | ||
| 47 | 'internal) | ||
| 48 | 'browse-url--mailto)) | ||
| 49 | (should-not (browse-url-select-handler "mailto:foo@bar.org" | ||
| 50 | 'external))) | ||
| 51 | |||
| 52 | (ert-deftest browse-url-tests-select-handler-man () | ||
| 53 | (should (eq (browse-url-select-handler "man:ls") 'browse-url--man)) | ||
| 54 | (should (eq (browse-url-select-handler "man:ls" 'internal) | ||
| 55 | 'browse-url--man)) | ||
| 56 | (should-not (browse-url-select-handler "man:ls" 'external))) | ||
| 57 | |||
| 58 | (ert-deftest browse-url-tests-select-handler-file () | ||
| 59 | (should (eq (browse-url-select-handler "file://foo.txt") | ||
| 60 | 'browse-url-emacs)) | ||
| 61 | (should (eq (browse-url-select-handler "file://foo.txt" 'internal) | ||
| 62 | 'browse-url-emacs)) | ||
| 63 | (should-not (browse-url-select-handler "file://foo.txt" 'external))) | ||
| 64 | |||
| 65 | (ert-deftest browse-url-tests-url-encode-chars () | ||
| 66 | (should (equal (browse-url-url-encode-chars "foobar" "[ob]") | ||
| 67 | "f%6F%6F%62ar"))) | ||
| 68 | |||
| 69 | (ert-deftest browse-url-tests-encode-url () | ||
| 70 | (should (equal (browse-url-encode-url "") "")) | ||
| 71 | (should (equal (browse-url-encode-url "a b c") "a b c")) | ||
| 72 | (should (equal (browse-url-encode-url "\"a\" \"b\"") | ||
| 73 | "\"a%22\"b\"")) | ||
| 74 | (should (equal (browse-url-encode-url "(a) (b)") "(a%29(b)")) | ||
| 75 | (should (equal (browse-url-encode-url "a$ b$") "a%24b$"))) | ||
| 76 | |||
| 77 | (ert-deftest browse-url-tests-url-at-point () | ||
| 78 | (with-temp-buffer | ||
| 79 | (insert "gnu.org") | ||
| 80 | (should (equal (browse-url-url-at-point) "http://gnu.org")))) | ||
| 81 | |||
| 82 | (ert-deftest browse-url-tests-file-url () | ||
| 83 | (should (equal (browse-url-file-url "/foo") "file:///foo")) | ||
| 84 | (should (equal (browse-url-file-url "/foo:") "ftp://foo/")) | ||
| 85 | (should (equal (browse-url-file-url "/ftp@foo:") "ftp://foo/")) | ||
| 86 | (should (equal (browse-url-file-url "/anonymous@foo:") | ||
| 87 | "ftp://foo/"))) | ||
| 88 | |||
| 89 | (ert-deftest browse-url-tests-delete-temp-file () | ||
| 90 | (let ((browse-url-temp-file-name | ||
| 91 | (make-temp-file "browse-url-tests-"))) | ||
| 92 | (browse-url-delete-temp-file) | ||
| 93 | (should-not (file-exists-p browse-url-temp-file-name))) | ||
| 94 | (let ((file (make-temp-file "browse-url-tests-"))) | ||
| 95 | (browse-url-delete-temp-file file) | ||
| 96 | (should-not (file-exists-p file)))) | ||
| 97 | |||
| 98 | (ert-deftest browse-url-tests-add-buttons () | ||
| 99 | (with-temp-buffer | ||
| 100 | (insert "Visit https://gnu.org") | ||
| 101 | (goto-char (point-min)) | ||
| 102 | (browse-url-add-buttons) | ||
| 103 | (goto-char (- (point-max) 1)) | ||
| 104 | (should (eq (get-text-property (point) 'face) | ||
| 105 | 'browse-url-button)) | ||
| 106 | (should (get-text-property (point) 'browse-url-data)))) | ||
| 107 | |||
| 108 | (ert-deftest browse-url-tests-button-copy () | ||
| 109 | (with-temp-buffer | ||
| 110 | (insert "Visit https://gnu.org") | ||
| 111 | (goto-char (point-min)) | ||
| 112 | (browse-url-add-buttons) | ||
| 113 | (should-error (browse-url-button-copy)) | ||
| 114 | (goto-char (- (point-max) 1)) | ||
| 115 | (browse-url-button-copy) | ||
| 116 | (should (equal (car kill-ring) "https://gnu.org")))) | ||
| 117 | |||
| 118 | (provide 'browse-url-tests) | ||
| 119 | ;;; browse-url-tests.el ends here | ||
diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index 7a982548ae1..cf416155e50 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el | |||
| @@ -136,7 +136,20 @@ | |||
| 136 | (t | 136 | (t |
| 137 | )))) | 137 | )))) |
| 138 | 138 | ||
| 139 | (defun network-test--resolve-system-name () | ||
| 140 | (cl-loop for address in (network-lookup-address-info (system-name)) | ||
| 141 | when (or (and (= (length address) 5) | ||
| 142 | ;; IPv4 localhost addresses start with 127. | ||
| 143 | (= (elt address 0) 127)) | ||
| 144 | (and (= (length address) 9) | ||
| 145 | ;; IPv6 localhost address. | ||
| 146 | (equal address [0 0 0 0 0 0 0 1 0]))) | ||
| 147 | return t)) | ||
| 148 | |||
| 139 | (ert-deftest echo-server-with-dns () | 149 | (ert-deftest echo-server-with-dns () |
| 150 | (unless (network-test--resolve-system-name) | ||
| 151 | (ert-skip "Can't test resolver for (system-name)")) | ||
| 152 | |||
| 140 | (let* ((server (make-server (system-name))) | 153 | (let* ((server (make-server (system-name))) |
| 141 | (port (aref (process-contact server :local) 4)) | 154 | (port (aref (process-contact server :local) 4)) |
| 142 | (proc (make-network-process :name "foo" | 155 | (proc (make-network-process :name "foo" |
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index ac24fcf280a..05196e7e4a6 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el | |||
| @@ -2001,12 +2001,13 @@ is greater than 10. | |||
| 2001 | (skip-unless (tramp--test-enabled)) | 2001 | (skip-unless (tramp--test-enabled)) |
| 2002 | 2002 | ||
| 2003 | ;; Multi hops are allowed for inline methods only. | 2003 | ;; Multi hops are allowed for inline methods only. |
| 2004 | (should-error | 2004 | (let (non-essential) |
| 2005 | (file-remote-p "/ssh:user1@host1|method:user2@host2:/path/to/file") | 2005 | (should-error |
| 2006 | :type 'user-error) | 2006 | (expand-file-name "/ssh:user1@host1|method:user2@host2:/path/to/file") |
| 2007 | (should-error | 2007 | :type 'user-error) |
| 2008 | (file-remote-p "/method:user1@host1|ssh:user2@host2:/path/to/file") | 2008 | (should-error |
| 2009 | :type 'user-error) | 2009 | (expand-file-name "/method:user1@host1|ssh:user2@host2:/path/to/file") |
| 2010 | :type 'user-error)) | ||
| 2010 | 2011 | ||
| 2011 | ;; Samba does not support file names with periods followed by | 2012 | ;; Samba does not support file names with periods followed by |
| 2012 | ;; spaces, and trailing periods or spaces. | 2013 | ;; spaces, and trailing periods or spaces. |
| @@ -5681,9 +5682,8 @@ This does not support special file names." | |||
| 5681 | 5682 | ||
| 5682 | (defun tramp--test-sh-p () | 5683 | (defun tramp--test-sh-p () |
| 5683 | "Check, whether the remote host runs a based method from tramp-sh.el." | 5684 | "Check, whether the remote host runs a based method from tramp-sh.el." |
| 5684 | (eq | 5685 | (tramp-sh-file-name-handler-p |
| 5685 | (tramp-find-foreign-file-name-handler tramp-test-temporary-file-directory) | 5686 | (tramp-dissect-file-name tramp-test-temporary-file-directory))) |
| 5686 | 'tramp-sh-file-name-handler)) | ||
| 5687 | 5687 | ||
| 5688 | (defun tramp--test-sudoedit-p () | 5688 | (defun tramp--test-sudoedit-p () |
| 5689 | "Check, whether the sudoedit method is used." | 5689 | "Check, whether the sudoedit method is used." |
diff --git a/test/lisp/saveplace-resources/saveplace b/test/lisp/saveplace-resources/saveplace new file mode 100644 index 00000000000..3f3f6d501d6 --- /dev/null +++ b/test/lisp/saveplace-resources/saveplace | |||
| @@ -0,0 +1,4 @@ | |||
| 1 | ;;; -*- coding: utf-8 -*- | ||
| 2 | (("/home/skangas/.emacs.d/cache/recentf" . 1306) | ||
| 3 | ("/home/skangas/wip/emacs/" | ||
| 4 | (dired-filename . "/home/skangas/wip/emacs/COPYING"))) | ||
diff --git a/test/lisp/saveplace-tests.el b/test/lisp/saveplace-tests.el new file mode 100644 index 00000000000..ae7749fe930 --- /dev/null +++ b/test/lisp/saveplace-tests.el | |||
| @@ -0,0 +1,103 @@ | |||
| 1 | ;;; saveplace-tests.el --- Tests for saveplace.el -*- lexical-binding:t -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2019-2020 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Stefan Kangas <stefankangas@gmail.com> | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 10 | ;; it under the terms of the GNU General Public License as published by | ||
| 11 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 12 | ;; (at your option) any later version. | ||
| 13 | |||
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 17 | ;; GNU General Public License for more details. | ||
| 18 | |||
| 19 | ;; You should have received a copy of the GNU General Public License | ||
| 20 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 21 | |||
| 22 | ;;; Commentary: | ||
| 23 | |||
| 24 | (require 'ert) | ||
| 25 | (require 'saveplace) | ||
| 26 | |||
| 27 | (defvar saveplace-tests-dir | ||
| 28 | (file-truename | ||
| 29 | (expand-file-name "saveplace-resources" | ||
| 30 | (file-name-directory (or load-file-name | ||
| 31 | buffer-file-name))))) | ||
| 32 | |||
| 33 | (ert-deftest saveplace-test-save-place-to-alist/dir () | ||
| 34 | (save-place-mode) | ||
| 35 | (let* ((save-place-alist nil) | ||
| 36 | (save-place-loaded t) | ||
| 37 | (loc saveplace-tests-dir)) | ||
| 38 | (save-window-excursion | ||
| 39 | (dired loc) | ||
| 40 | (save-place-to-alist) | ||
| 41 | (should (equal save-place-alist | ||
| 42 | `((,(concat loc "/") | ||
| 43 | (dired-filename . ,(concat loc "/saveplace"))))))))) | ||
| 44 | |||
| 45 | (ert-deftest saveplace-test-save-place-to-alist/file () | ||
| 46 | (save-place-mode) | ||
| 47 | (let* ((tmpfile (make-temp-file "emacs-test-saveplace-")) | ||
| 48 | (save-place-alist nil) | ||
| 49 | (save-place-loaded t) | ||
| 50 | (loc tmpfile) | ||
| 51 | (pos 4)) | ||
| 52 | (unwind-protect | ||
| 53 | (save-window-excursion | ||
| 54 | (find-file loc) | ||
| 55 | (insert "abc") ; must insert something | ||
| 56 | (save-place-to-alist) | ||
| 57 | (should (equal save-place-alist (list (cons tmpfile pos))))) | ||
| 58 | (delete-file tmpfile)))) | ||
| 59 | |||
| 60 | (ert-deftest saveplace-test-forget-unreadable-files () | ||
| 61 | (save-place-mode) | ||
| 62 | (let* ((save-place-loaded t) | ||
| 63 | (tmpfile (make-temp-file "emacs-test-saveplace-")) | ||
| 64 | (alist-orig (list (cons "/this/file/does/not/exist" 10) | ||
| 65 | (cons tmpfile 1917))) | ||
| 66 | (save-place-alist alist-orig)) | ||
| 67 | (unwind-protect | ||
| 68 | (progn | ||
| 69 | (save-place-forget-unreadable-files) | ||
| 70 | (should (equal save-place-alist (cdr alist-orig)))) | ||
| 71 | (delete-file tmpfile)))) | ||
| 72 | |||
| 73 | (ert-deftest saveplace-test-place-alist-to-file () | ||
| 74 | (save-place-mode) | ||
| 75 | (let* ((tmpfile (make-temp-file "emacs-test-saveplace-")) | ||
| 76 | (tmpfile2 (make-temp-file "emacs-test-saveplace-")) | ||
| 77 | (save-place-file tmpfile) | ||
| 78 | (save-place-alist (list (cons tmpfile2 99)))) | ||
| 79 | (unwind-protect | ||
| 80 | (progn (save-place-alist-to-file) | ||
| 81 | (setq save-place-alist nil) | ||
| 82 | (save-window-excursion | ||
| 83 | (find-file save-place-file) | ||
| 84 | (unwind-protect | ||
| 85 | (should (string-match tmpfile2 (buffer-string))) | ||
| 86 | (kill-buffer)))) | ||
| 87 | (delete-file tmpfile) | ||
| 88 | (delete-file tmpfile2)))) | ||
| 89 | |||
| 90 | (ert-deftest saveplace-test-load-alist-from-file () | ||
| 91 | (save-place-mode) | ||
| 92 | (let ((save-place-loaded nil) | ||
| 93 | (save-place-file | ||
| 94 | (expand-file-name "saveplace" saveplace-tests-dir)) | ||
| 95 | (save-place-alist nil)) | ||
| 96 | (load-save-place-alist-from-file) | ||
| 97 | (should (equal save-place-alist | ||
| 98 | '(("/home/skangas/.emacs.d/cache/recentf" . 1306) | ||
| 99 | ("/home/skangas/wip/emacs/" | ||
| 100 | (dired-filename . "/home/skangas/wip/emacs/COPYING"))))))) | ||
| 101 | |||
| 102 | (provide 'saveplace-tests) | ||
| 103 | ;;; saveplace-tests.el ends here | ||
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el index 8e5cc95ec94..01d196565dd 100644 --- a/test/lisp/vc/vc-tests.el +++ b/test/lisp/vc/vc-tests.el | |||
| @@ -554,7 +554,8 @@ This checks also `vc-backend' and `vc-responsible-backend'." | |||
| 554 | 554 | ||
| 555 | (defvar vc-svn-program) | 555 | (defvar vc-svn-program) |
| 556 | (defun vc-test--svn-enabled () | 556 | (defun vc-test--svn-enabled () |
| 557 | (executable-find vc-svn-program)) | 557 | (and (executable-find "svnadmin") |
| 558 | (executable-find vc-svn-program))) | ||
| 558 | 559 | ||
| 559 | (defun vc-test--sccs-enabled () | 560 | (defun vc-test--sccs-enabled () |
| 560 | (executable-find "sccs")) | 561 | (executable-find "sccs")) |
diff --git a/test/lisp/wdired-tests.el b/test/lisp/wdired-tests.el index 5b01c54cf24..2cfabd1ee2d 100644 --- a/test/lisp/wdired-tests.el +++ b/test/lisp/wdired-tests.el | |||
| @@ -143,6 +143,7 @@ wdired-get-filename before and after editing." | |||
| 143 | (let* ((test-dir (make-temp-file "test-dir-" t)) | 143 | (let* ((test-dir (make-temp-file "test-dir-" t)) |
| 144 | (server-socket-dir test-dir) | 144 | (server-socket-dir test-dir) |
| 145 | (dired-listing-switches "-Fl") | 145 | (dired-listing-switches "-Fl") |
| 146 | (dired-ls-F-marks-symlinks (eq system-type 'darwin)) | ||
| 146 | (buf (find-file-noselect test-dir))) | 147 | (buf (find-file-noselect test-dir))) |
| 147 | (unwind-protect | 148 | (unwind-protect |
| 148 | (progn | 149 | (progn |