aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndrea Corallo2020-08-09 15:03:23 +0200
committerAndrea Corallo2020-08-09 15:03:23 +0200
commit12a982d9789052d8e85efcacb4b311f4876c882a (patch)
treea452a8e888c6ee9c85d6a487359b7a1c0c9fa15b
parent80d7f710f2fab902e46aa3fddb8e1c1795420af3 (diff)
parent8e82baf5a730ff542118ddba5b76afdc1db643f6 (diff)
downloademacs-12a982d9789052d8e85efcacb4b311f4876c882a.tar.gz
emacs-12a982d9789052d8e85efcacb4b311f4876c882a.zip
Merge remote-tracking branch 'savannah/master' into HEAD
-rw-r--r--.gitignore1
-rw-r--r--ChangeLog.32
-rw-r--r--admin/authors.el1
-rw-r--r--configure.ac82
-rw-r--r--doc/emacs/calendar.texi5
-rw-r--r--doc/emacs/display.texi4
-rw-r--r--doc/emacs/files.texi7
-rw-r--r--doc/emacs/help.texi10
-rw-r--r--doc/emacs/killing.texi4
-rw-r--r--doc/emacs/misc.texi19
-rw-r--r--doc/lispref/display.texi9
-rw-r--r--doc/lispref/edebug.texi10
-rw-r--r--doc/lispref/os.texi6
-rw-r--r--doc/misc/emacs-mime.texi20
-rw-r--r--doc/misc/eww.texi16
-rw-r--r--doc/misc/message.texi60
-rw-r--r--doc/misc/tramp.texi87
-rw-r--r--etc/MACHINES25
-rw-r--r--etc/NEWS160
-rw-r--r--etc/PROBLEMS135
-rw-r--r--etc/emacs-mail.desktop10
-rw-r--r--etc/themes/leuven-theme.el686
-rw-r--r--etc/tutorials/TUTORIAL14
-rw-r--r--lib/c++defs.h4
-rw-r--r--lib/cdefs.h2
-rw-r--r--lib/count-leading-zeros.h3
-rw-r--r--lib/count-trailing-zeros.h3
-rw-r--r--lib/gnulib.mk.in13
-rw-r--r--lisp/Makefile.in1
-rw-r--r--lisp/arc-mode.el115
-rw-r--r--lisp/bookmark.el13
-rw-r--r--lisp/buff-menu.el60
-rw-r--r--lisp/button.el51
-rw-r--r--lisp/calendar/cal-dst.el16
-rw-r--r--lisp/calendar/calendar.el7
-rw-r--r--lisp/calendar/solar.el10
-rw-r--r--lisp/calendar/time-date.el15
-rw-r--r--lisp/cus-dep.el10
-rw-r--r--lisp/cus-edit.el5
-rw-r--r--lisp/custom.el14
-rw-r--r--lisp/dired-aux.el20
-rw-r--r--lisp/dired.el2
-rw-r--r--lisp/emacs-lisp/autoload.el16
-rw-r--r--lisp/emacs-lisp/byte-opt.el29
-rw-r--r--lisp/emacs-lisp/byte-run.el17
-rw-r--r--lisp/emacs-lisp/bytecomp.el93
-rw-r--r--lisp/emacs-lisp/cl-generic.el16
-rw-r--r--lisp/emacs-lisp/cl-macs.el7
-rw-r--r--lisp/emacs-lisp/edebug.el31
-rw-r--r--lisp/emacs-lisp/hierarchy.el579
-rw-r--r--lisp/emacs-lisp/seq.el1
-rw-r--r--lisp/epa-file.el30
-rw-r--r--lisp/erc/erc-capab.el16
-rw-r--r--lisp/erc/erc-compat.el10
-rw-r--r--lisp/erc/erc-dcc.el10
-rw-r--r--lisp/erc/erc-list.el28
-rw-r--r--lisp/erc/erc-log.el2
-rw-r--r--lisp/erc/erc-match.el6
-rw-r--r--lisp/erc/erc-networks.el2
-rw-r--r--lisp/erc/erc.el132
-rw-r--r--lisp/files.el2
-rw-r--r--lisp/finder.el2
-rw-r--r--lisp/generic-x.el2
-rw-r--r--lisp/gnus/gnus-art.el34
-rw-r--r--lisp/gnus/gnus-icalendar.el3
-rw-r--r--lisp/gnus/gnus-sum.el2
-rw-r--r--lisp/gnus/gnus-util.el1
-rw-r--r--lisp/gnus/gnus-win.el2
-rw-r--r--lisp/gnus/message.el201
-rw-r--r--lisp/gnus/mm-decode.el6
-rw-r--r--lisp/gnus/mm-view.el10
-rw-r--r--lisp/gnus/mml-sec.el12
-rw-r--r--lisp/gnus/mml.el13
-rw-r--r--lisp/gnus/smime.el3
-rw-r--r--lisp/help-fns.el44
-rw-r--r--lisp/hi-lock.el4
-rw-r--r--lisp/ibuf-ext.el6
-rw-r--r--lisp/image-file.el12
-rw-r--r--lisp/image-mode.el153
-rw-r--r--lisp/image/image-converter.el14
-rw-r--r--lisp/international/ja-dic-cnv.el13
-rw-r--r--lisp/mouse.el5
-rw-r--r--lisp/net/browse-url.el136
-rw-r--r--lisp/net/eww.el18
-rw-r--r--lisp/net/tramp-adb.el323
-rw-r--r--lisp/net/tramp-sh.el462
-rw-r--r--lisp/net/tramp.el169
-rw-r--r--lisp/outline.el11
-rw-r--r--lisp/play/snake.el1
-rw-r--r--lisp/progmodes/cperl-mode.el45
-rw-r--r--lisp/progmodes/project.el8
-rw-r--r--lisp/progmodes/sh-script.el2
-rw-r--r--lisp/progmodes/sql.el20
-rw-r--r--lisp/recentf.el3
-rw-r--r--lisp/saveplace.el12
-rw-r--r--lisp/scroll-lock.el2
-rw-r--r--lisp/simple.el37
-rw-r--r--lisp/skeleton.el101
-rw-r--r--lisp/so-long.el88
-rw-r--r--lisp/subr.el6
-rw-r--r--lisp/tar-mode.el50
-rw-r--r--lisp/textmodes/css-mode.el2
-rw-r--r--lisp/textmodes/sgml-mode.el10
-rw-r--r--lisp/thingatpt.el2
-rw-r--r--lisp/vc/vc-hg.el61
-rw-r--r--lisp/wdired.el15
-rw-r--r--lisp/whitespace.el25
-rw-r--r--lisp/wid-edit.el57
-rw-r--r--lisp/x-dnd.el4
-rw-r--r--m4/alloca.m414
-rw-r--r--m4/gnulib-common.m46
-rw-r--r--m4/gnulib-comp.m42
-rw-r--r--m4/largefile.m42
-rw-r--r--m4/libgmp.m488
-rw-r--r--src/alloc.c52
-rw-r--r--src/buffer.c6
-rw-r--r--src/bytecode.c11
-rw-r--r--src/callint.c4
-rw-r--r--src/data.c6
-rw-r--r--src/dispnew.c7
-rw-r--r--src/editfns.c3
-rw-r--r--src/emacs-module.c8
-rw-r--r--src/emacs.c1
-rw-r--r--src/frame.c39
-rw-r--r--src/fringe.c5
-rw-r--r--src/gmalloc.c16
-rw-r--r--src/image.c20
-rw-r--r--src/lisp.h42
-rw-r--r--src/nsimage.m12
-rw-r--r--src/nsterm.h3
-rw-r--r--src/nsterm.m12
-rw-r--r--src/pdumper.c6
-rw-r--r--src/process.c97
-rw-r--r--src/ptr-bounds.h79
-rw-r--r--src/regex-emacs.c6
-rw-r--r--src/search.c6
-rw-r--r--src/xdisp.c54
-rw-r--r--src/xfns.c2
-rw-r--r--test/README5
-rw-r--r--test/data/mml-sec/.gpg-v21-migrated0
-rw-r--r--test/data/mml-sec/gpg-agent.conf5
-rw-r--r--test/data/mml-sec/private-keys-v1.d/02089CDDC6DFE93B8EA10D9E876F983E61FEC476.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/171B444DE92BEF997229000D9784118A94EEC1C9.keybin0 -> 526 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/19FFEBC04DF3E037E16F6A4474DCB7984406975D.keybin0 -> 841 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/1E36D27DF9DAB96302D35268DADC5CE73EF45A2A.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/293109315BE584AB2EFEFCFCAD64666221D8B36C.keybin0 -> 526 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/335689599E1C0F66D73ADCF51E03EE36C97D121F.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/40BF94E540E3726CB150A1ADF7C1B514444B3FA6.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/515D4637EFC6C09DB1F78BE8C2F2A3D63E7756C3.keybin0 -> 798 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/5A11B1935C46D0B227A73978DCA1293A85604F1D.keybin0 -> 798 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/62643CEBC7AEBE6817577A34399483700D76BD64.keybin0 -> 526 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/680D01F368916A0021C14E3453B27B3C5F900683.keybin0 -> 710 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/6DF2D9DF7AED06F0524BEB642DF0FB48EFDBDB93.keybin0 -> 798 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/78C17E134E86E691297F7B719B2F2CDF41976234.keybin0 -> 527 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/7F714F4D9D9676638214991E96D45704E4FFC409.keybin0 -> 798 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/854752F5D8090CA36EFBDD79C72BDFF6FA2D1FF0.keybin0 -> 526 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/93FF37C268FDBF0767F5FFDC49409DDAC9388B2C.keybin0 -> 709 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/A3BA94EAE83509CC90DB1B77B54A51959D8DABEA.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/A73E9D01F0465B518E8E7D5AD529077AAC1603B4.keybin0 -> 710 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/AE6A24B17A8D0CAF9B7E000AA77F0B41D7BFFFCF.keybin0 -> 841 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/C072AF82DCCCB9A7F1B85FFA10B802DC4ED16703.keybin0 -> 841 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/C43E1A079B28DFAEBB39CBA01793BDE11EF4B490.keybin0 -> 527 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/C67DAD345455EAD6D51368008FC3A53B8D195B5A.keybin0 -> 710 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/CB5E00CE582C2645D2573FC16B2F14F85A7F47AA.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/CC68630A06B048F5A91136C162C7A3273E20DE6F.keybin0 -> 710 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/E7E73903E1BF93481DE0E7C9769D6C31E1863CFF.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/F0117468BE801ED4B81972E159A98FDD4814DCEC.keybin0 -> 797 bytes
-rw-r--r--test/data/mml-sec/private-keys-v1.d/F4C5EFD5779BE892CAFD5B721D68DED677C9B151.keybin0 -> 841 bytes
-rw-r--r--test/data/mml-sec/pubring.gpgbin0 -> 13883 bytes
-rw-r--r--test/data/mml-sec/pubring.kbxbin0 -> 3076 bytes
-rw-r--r--test/data/mml-sec/secring.gpgbin0 -> 17362 bytes
-rw-r--r--test/data/mml-sec/trustdb.gpgbin0 -> 1880 bytes
-rw-r--r--test/data/mml-sec/trustlist.txt26
-rw-r--r--test/lisp/calendar/time-date-tests.el14
-rw-r--r--test/lisp/emacs-lisp/bytecomp-tests.el5
-rw-r--r--test/lisp/emacs-lisp/cconv-tests.el160
-rw-r--r--test/lisp/emacs-lisp/cl-generic-tests.el38
-rw-r--r--test/lisp/emacs-lisp/edebug-tests.el94
-rw-r--r--test/lisp/emacs-lisp/generator-tests.el4
-rw-r--r--test/lisp/emacs-lisp/hierarchy-tests.el556
-rw-r--r--test/lisp/erc/erc-tests.el47
-rw-r--r--test/lisp/gnus/gnus-util-tests.el76
-rw-r--r--test/lisp/gnus/mml-sec-tests.el895
-rw-r--r--test/lisp/net/browse-url-tests.el119
-rw-r--r--test/lisp/net/network-stream-tests.el13
-rw-r--r--test/lisp/net/tramp-tests.el18
-rw-r--r--test/lisp/saveplace-resources/saveplace4
-rw-r--r--test/lisp/saveplace-tests.el103
-rw-r--r--test/lisp/vc/vc-tests.el3
-rw-r--r--test/lisp/wdired-tests.el1
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
153test/manual/etags/ETAGS 153test/manual/etags/ETAGS
154test/manual/etags/CTAGS 154test/manual/etags/CTAGS
155test/manual/indent/*.new 155test/manual/indent/*.new
156test/data/mml-sec/random_seed
156 157
157# ctags, etags. 158# ctags, etags.
158TAGS 159TAGS
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
587822018-07-17 Alex <agrambot@gmail.com> 587822018-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
2292test $with_unexec = yes && 2266test $with_unexec = yes &&
2293case "$opsys" in 2267case "$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
4601AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]]) 4575AC_CHECK_MEMBERS([struct unipair.unicode], [], [], [[#include <linux/kd.h>]])
4602 4576
4603AC_CHECK_FUNCS_ONCE([sbrk]) 4577AC_CHECK_FUNCS_ONCE([__lsan_ignore_object sbrk])
4604 4578
4605AC_FUNC_FORK 4579AC_FUNC_FORK
4606 4580
4607AC_CHECK_FUNCS(snprintf __lsan_ignore_object) 4581dnl AC_CHECK_FUNCS_ONCE wouldn’t be right for snprintf, which needs
4582dnl the current CFLAGS etc.
4583AC_CHECK_FUNCS(snprintf)
4608 4584
4609dnl Check for glib. This differs from other library checks in that 4585dnl Check for glib. This differs from other library checks in that
4610dnl Emacs need not link to glib unless some other library is already 4586dnl Emacs need not link to glib unless some other library is already
@@ -4778,7 +4754,7 @@ if test "$USE_X_TOOLKIT" != "none"; then
4778fi 4754fi
4779 4755
4780case $opsys in 4756case $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
4792case $opsys in 4768case $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
4840esac 4816esac
4841 4817
4842case $opsys in 4818case $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
4989case $opsys in 4965case $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)
5083else 5059else
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
5129esac 5105esac
5130 5106
5131case $opsys in 5107case $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
5141case $opsys in 5117case $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},
626for how daylight saving time is determined. 626for 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"})
630instead 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
629variables for your usual physical location in your @file{.emacs} file. 634variables for your usual physical location in your @file{.emacs} file.
630If you are a system administrator, you may want to set these variables 635If 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
1335Highlight newlines. 1335Highlight newlines.
1336 1336
1337@item missing-newline-at-eof
1338Highlight the final character if the buffer doesn't end with a newline
1339character.
1340
1337@item empty 1341@item empty
1338Highlight empty lines at the beginning and/or end of the buffer. 1342Highlight 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
2150You can press @kbd{n} (@code{image-next-file}) and @kbd{p} 2150You 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
2152previous image file in the same directory, respectively. 2152previous image file in the same directory, respectively. These
2153commands will consult the ``parent'' dired buffer to determine what
2154the next/previous image file is. These commands also work when
2155opening a file from archive files (like zip or tar files), and will
2156then instead consult the archive mode buffer. If neither an archive
2157nor 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.
220command is not on any key, that means you must use @kbd{M-x} to run 220command is not on any key, that means you must use @kbd{M-x} to run
221it. @kbd{C-h w} runs the command @code{where-is}. 221it. @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
226Emacs Lisp Reference Manual}) and widgets
227(@pxref{Introduction,,,widget, Emacs Widgets}) that can be clicked to
228perform some action. To find out what function is ultimately invoked
229by these buttons, Emacs provides the @code{button-describe} and
230@code{widget-describe} commands, that should be run with point over
231the 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
728minibuffer and executes it as a shell command, in a subshell made just 729minibuffer and executes it as a shell command, in a subshell made just
729for that command. Standard input for the command comes from the null 730for that command. Standard input for the command comes from the null
730device. If the shell command produces any output, the output appears 731device. If the shell command produces any output, the output appears
731either in the echo area (if it is short), or in an Emacs buffer named 732either in the echo area (if it is short), or in an Emacs buffer,
732@file{*Shell Command Output*}, displayed in another window (if the 733displayed in another window (if the output is long). The name of
733output is long). The variables @code{resize-mini-windows} and 734this buffer is taken from the constant @code{shell-command-buffer-name}.
735The 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
735Emacs should consider the output to be too long for the echo area. 737Emacs 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.
763You can also type @kbd{M-&} (@code{async-shell-command}) to execute a 766You can also type @kbd{M-&} (@code{async-shell-command}) to execute a
764shell command asynchronously; this is exactly like calling @kbd{M-!} 767shell command asynchronously; this is exactly like calling @kbd{M-!}
765with a trailing @samp{&}, except that you do not need the @samp{&}. 768with a trailing @samp{&}, except that you do not need the @samp{&}.
766The default output buffer for asynchronous shell commands is named 769The constant @code{shell-command-buffer-name-async} stores the name
767@samp{*Async Shell Command*}. Emacs inserts the output into this 770of the default output buffer for asynchronous shell commands.
768buffer as it comes in, whether or not the buffer is visible in a 771Emacs inserts the output into this buffer as it comes in,
769window. 772whether 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.
804see what keys are in the buffer. If the buffer contains a GnuPG key, 807see what keys are in the buffer. If the buffer contains a GnuPG key,
805type @kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents 808type @kbd{C-x h M-| gpg @key{RET}} to feed the entire buffer contents
806to @command{gpg}. This will output the list of keys to the 809to @command{gpg}. This will output the list of keys to the
807@file{*Shell Command Output*} buffer. 810buffer 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}
5573The value, @var{height}, specifies the height of the image, in pixels. 5573The value, @var{height}, specifies the height of the image, in pixels.
5574 5574
5575Note that @code{:width} and @code{:height} can only be used if passing
5576in data that doesn't specify the width and height (e.g., a string or a
5577vector containing the bits of the image). @acronym{XBM} files usually
5578specify this themselves, and it's an error to use these two properties
5579on these files. Also note that @code{:width} and @code{:height} are
5580used by most other image formats to specify what the displayed image
5581is supposed to be, which usually means performing some sort of
5582scaling. This isn't supported for @acronym{XBM} images.
5583
5575@item :stride @var{stride} 5584@item :stride @var{stride}
5576The number of bool vector entries stored for each row; the smallest 5585The number of bool vector entries stored for each row; the smallest
5577multiple of 8 greater than or equal to @var{width}. 5586multiple 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,
1438static component to the name of the definition. It may be used more 1438static component to the name of the definition. It may be used more
1439than once. 1439than once.
1440 1440
1441@item :unique
1442This construct is like @code{:name}, but generates unique names. It
1443does not match an argument. The element following @code{:unique}
1444should be a string; it is used as the prefix for an additional name
1445component for the definition. You can use this to add a unique,
1446dynamic component to the name of the definition. This is useful for
1447macros that can define the same symbol multiple times in different
1448scopes, such as @code{cl-flet}; @ref{Function Bindings,,,cl}. It may
1449be used more than once.
1450
1441@item arg 1451@item arg
1442The argument, a symbol, is the name of an argument of the defining form. 1452The argument, a symbol, is the name of an argument of the defining form.
1443However, lambda-list keywords (symbols starting with @samp{&}) 1453However, 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
472to launch any external programs, set this variable to @code{nil} or 472to 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
477If non-@code{nil}, inlined parts that support font locking (for
478instance, patches or code snippets) will be font-locked. This may be
479overriden by callers that have their own ways of enabling/inhibiting
480font 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
688Valid values are @samp{7bit}, @samp{8bit}, @samp{quoted-printable} and 695Valid values are @samp{7bit}, @samp{8bit}, @samp{quoted-printable} and
689@samp{base64} (@code{Content-Transfer-Encoding}). @xref{Charset 696@samp{base64}. @xref{Charset
690Translation}. 697Translation}. This parameter says what
698@code{Content-Transfer-Encoding} to use when sending the part, and is
699normally computed automatically.
700
701@item data-encoding
702This parameter says what encoding has been used on the data, and the
703data will be decoded before use. Valid values are
704@samp{quoted-printable} and @samp{base64}. This is useful when you
705have a part with binary data (for instance an image) inserted directly
706into the Message buffer inside the @samp{"<#part>...<#/part>"} tags.
691 707
692@item description 708@item description
693A description of the part (@code{Content-Description}). 709A 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
56Appendices 57Appendices
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
344It 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
348emacs -f eww-browse https://gnu.org
349@end example
350
351This also allows registering Emacs as a @acronym{MIME} handler for the
352@samp{"text/x-uri"} media type. How to do that varies between
353systems, 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
104You can customize the Message Mode tool bar, see @kbd{M-x 105You 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
529fellow who posted a message knows where the followups need to go 530fellow who posted a message knows where the followups need to go
530better than you do. 531better than you do.
531 532
533
534@node System Mailer Setup
535@section System Mailer Setup
536@cindex mailto:
537
538Emacs can be set up as the system mailer, so that Emacs is opened when
539you click on @samp{mailto:} links in other programs.
540
541How this is done varies from system to system, but commonly there's a
542way to set the default application for a @acronym{MIME} type, and the
543relevant type here is @samp{x-scheme-handler/mailto;}.
544
545The application to start should be @samp{"emacs -f message-mailto %u"}.
546This will start Emacs, and then run the @code{message-mailto}
547command. It will parse the given @acronym{URL}, and set up a Message
548buffer with the given parameters.
549
550For instance, @samp{mailto:larsi@@gnus.org?subject=This+is+a+test}
551will 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
884whether or not to specify options. 908whether 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
914If your system supports it, you can also insert screenshots directly
915into the Message buffer. The @kbd{C-c C-p}
916(@code{message-insert-screenshot}) command inserts the image into the
917buffer as an @acronym{MML} part, and puts an image text property on
918top. The @code{message-screenshot-command} variable says what
919external command to use to take the screenshot. It defaults to
920@code{"import png:-"}, which is an ImageMagick command.
921
886You can also create arbitrarily complex multiparts using the @acronym{MML} 922You can also create arbitrarily complex multiparts using the @acronym{MML}
887language (@pxref{Composing, , Composing, emacs-mime, The Emacs MIME 923language (@pxref{Composing, , Composing, emacs-mime, The Emacs MIME
888Manual}). 924Manual}).
@@ -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
1258The @samp{OpenPGP} header can be used to provide information about the
1259sender's OpenPGP key. This is a formalization and modernization of
1260the non-standard @samp{X-PGP-Key} (etc.) headers that have been in use
1261for 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
1265To use this in Message, say:
1266
1267@lisp
1268(add-hook 'message-send-hook 'message-add-openpgp-header)
1269@end lisp
1270
1271@noindent
1272then customize the @code{message-openpgp-header} variable according to
1273your PGP setup. The variable is a list of the key ID, the key URL or
1274ASCII 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
2053default value is @t{"/data/local/tmp"} for the @option{adb} method, 2053default 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
2058When this property is non-@code{nil}, an alternative, more performant
2059implementation of @code{make-process} and
2060@code{start-file-process} is applied. @ref{Improving performance of
2061asynchronous remote processes} for a discussion of constraints.
2062
2056@item @t{"posix"} 2063@item @t{"posix"}
2057 2064
2058Connections using the @option{smb} method check, whether the remote 2065Connections 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
2099differences in hosts and paths, for example, @file{/bin:/usr/bin} on 2106differences in hosts and paths, for example, @file{/bin:/usr/bin} on
2100Debian GNU/Linux or 2107Debian 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
2102Solaris, @value{tramp} queries the remote host with @command{getconf 2109Solaris, @value{tramp} queries the remote host with @command{getconf
2103PATH} and updates the symbol @code{tramp-default-remote-path}. 2110PATH} 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*} 3382named @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
3379continuous output. 3385continuous 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
3544initialization, every process invocation. This is needed for handling
3545interactive dialogues when connecting the remote host (like providing
3546a password), and initial environment setup.
3547
3548Sometimes, this is not needed. Instead of starting a remote shell and
3549running the command afterwards, it is sufficient to run the command
3550directly. @value{tramp} supports this by an alternative
3551implementation of @code{make-process} and @code{start-file-process}.
3552This is triggered by the connection property
3553@t{"direct-async-process"}, @xref{Predefined connection information},
3554which 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
3564However, this approach has different limitations:
3565
3566@itemize
3567@item
3568It works only for connection methods defined in @file{tramp-sh.el} and
3569@file{tramp-adb.el}.
3570
3571@item
3572It does not support multi-hop methods.
3573
3574@item
3575It does not support interactive user authentication, like password
3576handling.
3577
3578@item
3579It does not support a separated error stream.
3580
3581@item
3582It cannot be killed via @code{interrupt-process}.
3583
3584@item
3585It does not report the remote terminal name via @code{process-tty-name}.
3586
3587@item
3588It does not use @code{tramp-remote-path} and
3589@code{tramp-remote-process-environment}.
3590
3591@item
3592It does not set environment variable @env{INSIDE_EMACS}.
3593@end itemize
3594
3595In 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
diff --git a/etc/NEWS b/etc/NEWS
index 492d01feed0..8118272070e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -59,6 +59,11 @@ shaping, so 'configure' now recommends that combination.
59It was declared obsolete in Emacs 27.1. 59It was declared obsolete in Emacs 27.1.
60 60
61--- 61---
62** Support for building with '-fcheck-pointer-bounds' has been removed.
63GCC has withdrawn the '-fcheck-pointer-bounds' option and support for
64its 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.
63OpenBSD 5.3 and older releases are no longer supported, as they lack 68OpenBSD 5.3 and older releases are no longer supported, as they lack
64proper pty support that Emacs needs. 69proper 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
86for the output of shell commands.
87
78** Support for '(box . SIZE)' 'cursor-type'. 88** Support for '(box . SIZE)' 'cursor-type'.
79By default, 'box' cursor always has a filled box shape. But if you 89By default, 'box' cursor always has a filled box shape. But if you
80specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow 90specify '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
118setting the variable 'auto-save-visited-mode' buffer-locally to nil. 128setting 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
132description of the properties. Likewise 'button-describe' does the
133same 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
171displayed and which are kept hidden. 186displayed and which are kept hidden.
172 187
188---
189*** New command bound to 'C': 'archive-copy-file'
190This command extracts the file under point and writes the data to a
191file.
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
179taken as a statement by the programmer that this should be indented 199taken as a statement by the programmer that this should be indented
180as a data list rather than as a piece of code. 200as 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.
205If non-nil, functions that display time zones (like the 'S' command in
206calendar mode that displays the sunrise time) will display time zones
207like "+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.
206Bookmark locations can refer to VC directory buffers. 233Bookmark locations can refer to VC directory buffers.
207 234
235---
236*** New user option 'vc-hg-create-bookmark' controls whether a bookmark
237or 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'
241headers.
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
224allow adjusting the fill width. 260allow adjusting the fill width.
225 261
262+++
263*** New variable 'mm-inline-font-lock'.
264This variable is supposed to be bound by callers to determine whether
265inline MIME parts (that support it) are supposed to be font-locked or
266not.
267
268** Message
269
270+++
271*** Message now supports the OpenPGP header.
272To generate these headers, add the new function
273'message-add-openpgp-header' to 'message-send-hook'. The header will
274be generated according to the new 'message-openpgp-header' variable.
275
276---
277*** A change to how Mail-Copies-To: never is handled.
278If a user has specified Mail-Copies-To: never, and Message was asked
279to do a "wide reply", some other arbitrary recipient would end up in
280the resulting To header, while the remaining recipients would be put
281in the Cc header. This is somewhat misleading, as it looks like
282you're responding to a specific person in particular. This has been
283changed so that all the recipients are put in the To header in these
284instances.
285
286+++
287*** New function to start Emacs in Message mode to send an email.
288Emacs can be defined as a handler for the "x-scheme-handler/mailto"
289MIME type with the following command: "emacs -f message-mailto %u".
290An emacs-mail.desktop file has been included, suitable for installing
291in desktop directories like /usr/share/applications. Clicking on a
292mailto: link in other applications will then open Emacs with headers
293filled 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.
228The 'Date' symbol has been removed from the default value, meaning that 298The '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
231from when it is first saved or delayed, add the symbol 'Date' back to 301from when it is first saved or delayed, add the symbol 'Date' back to
232this user option. 302this user option.
233 303
304+++
305*** New command to take screenshots.
306In Message mode buffers, the 'C-c C-p' ('message-insert-screenshot')
307command has been added. It depends on using an external program to
308take 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,
260unconditionally aborts the current edebug instrumentation with the 336unconditionally aborts the current edebug instrumentation with the
261supplied error message. 337supplied error message.
262 338
339*** Edebug specification lists can use the new keyword ':unique',
340which appends a unique suffix to the Edebug name of the current
341definition.
342
263+++ 343+++
264** ElDoc 344** ElDoc
265 345
@@ -314,6 +394,16 @@ This command marks a remote directory to contain only encrypted files.
314See the "(tramp) Keeping files encrypted" node of the Tramp manual for 394See the "(tramp) Keeping files encrypted" node of the Tramp manual for
315details. This feature is experimental. 395details. This feature is experimental.
316 396
397+++
398*** Support of direct asynchronous process invocation.
399When Tramp connection property "direct-async-process" is set to
400non-nil for a given connection, 'make-process' and 'start-file-process'
401calls are performed directly as in "ssh ... <command>". This avoids
402initialization performance penalties. See the "(tramp) Improving
403performance of asynchronous remote processes" node of the Tramp manual
404for details, and also for a discussion or restrictions. This feature
405is 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.
399The new default value is 2000000 (2 megabytes). 489The new default value is 2000000 (2 megabytes).
400 490
491** Whitespace mode
492
493+++
494*** New style 'missing-newline-at-eof'.
495If present in 'whitespace-style' (as it is by default), the final
496character in the buffer will be highlighted if the buffer doesn't end
497with 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.
578This 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
505decaying average of delays, and if this number gets too high, the 606decaying average of delays, and if this number gets too high, the
506animation is stopped. 607animation is stopped.
507 608
609+++
610*** The 'n' and 'p' commands (next/previous image) now respects dired order.
611These commands would previously display the next/previous image in
612alphabetical order, but will now find the "parent" dired buffer and
613select the next/previous image file according to how the files are
614sorted 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
616mode buffer.
617
508** EWW 618** EWW
509 619
510+++ 620+++
621*** New Emacs command line convenience function.
622The 'eww-browse' command has been added, which allows you to register
623Emacs as a MIME handler for "text/x-uri", and will call eww on the
624supplied 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.
512However, if "~/Downloads/" already exists, that will continue to be 628However, if "~/Downloads/" already exists, that will continue to be
513used. 629used.
@@ -565,6 +681,12 @@ Previously 'xml-print' would produce invalid XML when given a string
565with characters that are not valid in XML (see 681with characters that are not valid in XML (see
566https://www.w3.org/TR/xml/#charsets). Now it rejects such strings. 682https://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.
688Allowed 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.
730It's bound to the 'C-c C-c f' keystroke, and prompts for a local file
731name.
732
733---
734** Recentf
735The recentf files are no longer backed up.
736
737
738** Miscellaneous
739
740*** The new library hierarchy.el has been added.
741It's a library to create, query, navigate and display hierarchy
742structures.
743
744---
745*** The width of the buffer-name column in 'list-buffers' is now dynamic.
746The width now depends of the width of the window, but will never be
747wider than the length of the longest buffer name, except that it will
748never be narrower than 19 characters.
749
750*** Bookmarks can now be targets for new tabs.
751When the 'bookmark.el' library is loaded, a customize choice is added
752to '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'.
833This 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
683file mode specification into symbolic form. 838file 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,
707such as "2020-01-15T16:12:21-08:00". 862such as "2020-01-15T16:12:21-08:00".
708 863
864---
865** The new function 'decoded-time-period' has been added.
866It interprets a decoded time structure as a period and returns the
867equivalent 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
2222systems. 2222systems.
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.)
2225This was reported for Emacs 25.2 on i386-pc-solaris2.10 with Sun 2226This was reported for Emacs 25.2 on i386-pc-solaris2.10 with Sun
2226Studio 12 (Sun C 5.9) and with Oracle Developer Studio 12.6 (Sun C 2227Studio 12 (Sun C 5.9) and with Oracle Developer Studio 12.6 (Sun C
22275.15), and intermittently for sparc-sun-solaris2.10 with Oracle 22285.15), and intermittently for sparc-sun-solaris2.10 with Oracle
@@ -2239,66 +2240,6 @@ Solaris. See Bug#26638.
2239This is a Solaris feature (at least on Intel x86 cpus). Type C-r 2240This is a Solaris feature (at least on Intel x86 cpus). Type C-r
2240C-r C-t, to toggle whether C-x gets through to Emacs. 2241C-r C-t, to toggle whether C-x gets through to Emacs.
2241 2242
2242*** Problem with remote X server on Suns.
2243
2244On a Sun, running Emacs on one machine with the X server on another
2245may not work if you have used the unshared system libraries. This
2246is because the unshared libraries fail to use YP for host name lookup.
2247As 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
2251We suspect that this is a bug in the X libraries provided by
2252Sun. There is a report that one of these patches fixes the bug and
2253makes the problem stop:
2254
2255105216-01 105393-01 105518-01 105621-01 105665-01 105615-02 105216-02
2256105667-01 105401-08 105615-03 105621-02 105686-02 105736-01 105755-03
2257106033-01 105379-01 105786-01 105181-04 105379-03 105786-04 105845-01
2258105284-05 105669-02 105837-01 105837-02 105558-01 106125-02 105407-01
2259
2260Another person using a newer system (kernel patch level Generic_105181-06)
2261suspects that the bug was fixed by one of these more recent patches:
2262
2263106040-07 SunOS 5.6: X Input & Output Method patch
2264106222-01 OpenWindows 3.6: filemgr (ff.core) fixes
2265105284-12 Motif 1.2.7: sparc Runtime library patch
2266
2267*** Solaris 7 or 8: Emacs reports a BadAtom error (from X)
2268
2269This happens when Emacs was built on some other version of Solaris.
2270Rebuild it on Solaris 8.
2271
2272*** When using M-x dbx with the SparcWorks debugger, the 'up' and 'down'
2273commands do not move the arrow in Emacs.
2274
2275You 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
2280the fr.ISO-8859-15 locale (and maybe other related locales).
2281
2282You can fix this by editing the file:
2283
2284 /usr/openwin/lib/locale/iso8859-15/Compose
2285
2286Near the bottom there is a line that reads:
2287
2288 Ctrl<t> <quotedbl> <Y> : "\276" threequarters
2289
2290while it should read:
2291
2292 Ctrl<T> <quotedbl> <Y> : "\276" threequarters
2293
2294Note 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)".
2298This seems to be a GCC optimization bug that occurs for GCC 4.1.2 (-g
2299and -g -O2) and GCC 4.2.3 (-g -O and -g -O2). You can fix this by
2300compiling 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
2734This indicates a mismatch between the C compiler and preprocessor that 2675This indicates a mismatch between the C compiler and preprocessor that
2735configure is using. For example, on Solaris 10 trying to use 2676configure is using. For example, on Solaris 10 trying to use
2736CC=/opt/SUNWspro/bin/cc (the Sun Studio compiler) together with 2677CC=/opt/developerstudio12.6/bin/cc (the Oracle Developer Studio
2737CPP=/usr/ccs/lib/cpp can result in errors of this form (you may also 2678compiler) together with CPP=/usr/lib/cpp can result in errors of
2738see the error '"/usr/include/sys/isa_defs.h", line 500: undefined control'). 2679this form.
2739 2680
2740The solution is to tell configure to use the correct C preprocessor 2681The solution is to tell configure to use the correct C preprocessor
2741for your C compiler (CPP="/opt/SUNWspro/bin/cc -E" in the above 2682for your C compiler (CPP="/opt/developerstudio12.6/bin/cc -E" in the
2742example). 2683above example).
2743 2684
2744** Compilation 2685** Compilation
2745 2686
@@ -3110,7 +3051,69 @@ This section covers bugs reported on very old hardware or software.
3110If you are using hardware and an operating system shipped after 2000, 3051If you are using hardware and an operating system shipped after 2000,
3111it is unlikely you will see any of these. 3052it 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
3058On a Sun, running Emacs on one machine with the X server on another
3059may not work if you have used the unshared system libraries. This
3060is because the unshared libraries fail to use YP for host name lookup.
3061As 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
3065We suspect that this is a bug in the X libraries provided by
3066Sun. There is a report that one of these patches fixes the bug and
3067makes the problem stop:
3068
3069105216-01 105393-01 105518-01 105621-01 105665-01 105615-02 105216-02
3070105667-01 105401-08 105615-03 105621-02 105686-02 105736-01 105755-03
3071106033-01 105379-01 105786-01 105181-04 105379-03 105786-04 105845-01
3072105284-05 105669-02 105837-01 105837-02 105558-01 106125-02 105407-01
3073
3074Another person using a newer system (kernel patch level Generic_105181-06)
3075suspects that the bug was fixed by one of these more recent patches:
3076
3077106040-07 SunOS 5.6: X Input & Output Method patch
3078106222-01 OpenWindows 3.6: filemgr (ff.core) fixes
3079105284-12 Motif 1.2.7: sparc Runtime library patch
3080
3081*** Solaris 7 or 8: Emacs reports a BadAtom error (from X)
3082
3083This happens when Emacs was built on some other version of Solaris.
3084Rebuild it on Solaris 8.
3085
3086*** When using M-x dbx with the SparcWorks debugger, the 'up' and 'down'
3087commands do not move the arrow in Emacs.
3088
3089You 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
3094the fr.ISO-8859-15 locale (and maybe other related locales).
3095
3096You can fix this by editing the file:
3097
3098 /usr/openwin/lib/locale/iso8859-15/Compose
3099
3100Near the bottom there is a line that reads:
3101
3102 Ctrl<t> <quotedbl> <Y> : "\276" threequarters
3103
3104while it should read:
3105
3106 Ctrl<T> <quotedbl> <Y> : "\276" threequarters
3107
3108Note 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)".
3112This seems to be a GCC optimization bug that occurs for GCC 4.1.2 (-g
3113and -g -O2) and GCC 4.2.3 (-g -O and -g -O2). You can fix this by
3114compiling 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]
2Categories=Network;Email;
3Comment=GNU Emacs is an extensible, customizable text editor - and more
4Exec=emacs -f message-mailto %u
5Icon=emacs
6Name=Emacs (Mail)
7MimeType=x-scheme-handler/mailto;
8NoDisplay=false
9Terminal=false
10Type=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.
45The 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.
50This can be nil for unscaled, t for using the theme default, or a scaling
51number."
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.
60This can be nil for unscaled, t for using the theme default, or a scaling
61number."
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.
69CONTROL 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.
40Basic, Font Lock, Isearch, Gnus, Message, Diff, Ediff, Flyspell, 79Basic, Font Lock, Isearch, Gnus, Message, Org mode, Diff, Ediff,
41Semantic, and Ansi-Color faces are included -- and much more...") 80Flyspell, Semantic, and Ansi-Color faces are included -- and much
81more...")
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
612file's buffer. Having to switch back to that buffer, in order to save 612file's buffer. Having to switch back to that buffer, in order to save
613it with C-x C-s, would be a nuisance. So we have 613it 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
617C-x s asks you about each buffer which contains changes that you have 617C-x s asks you about each file-visiting buffer which contains changes
618not saved. It asks you, for each such buffer, whether to save the 618that you have not saved. It asks you, for each such buffer, whether
619buffer. 619to 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.
660There are many C-x commands. Here is a list of the ones you have learned: 660There 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).
1081You can learn more about Emacs by reading its manual, either as a 1081You can learn more about Emacs by reading its manual, either as a
1082printed book, or inside Emacs (use the Help menu or type C-h r). 1082printed book, or inside Emacs (use the Help menu or type C-h r).
1083Two features that you may like especially are completion, which saves 1083Two features that you may like especially are completion, which saves
1084typing, and dired, which simplifies file handling. 1084typing, and Dired, which simplifies file handling.
1085 1085
1086Completion is a way to avoid unnecessary typing. For instance, if you 1086Completion is a way to avoid unnecessary typing. For instance, if you
1087want to switch to the *Messages* buffer, you can type C-x b *M<Tab> 1087want 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@
246GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@ 246GL_GENERATE_BYTESWAP_H = @GL_GENERATE_BYTESWAP_H@
247GL_GENERATE_ERRNO_H = @GL_GENERATE_ERRNO_H@ 247GL_GENERATE_ERRNO_H = @GL_GENERATE_ERRNO_H@
248GL_GENERATE_EXECINFO_H = @GL_GENERATE_EXECINFO_H@ 248GL_GENERATE_EXECINFO_H = @GL_GENERATE_EXECINFO_H@
249GL_GENERATE_GMP_H = @GL_GENERATE_GMP_H@ 249GL_GENERATE_GMP_GMP_H = @GL_GENERATE_GMP_GMP_H@
250GL_GENERATE_IEEE754_H = @GL_GENERATE_IEEE754_H@ 250GL_GENERATE_IEEE754_H = @GL_GENERATE_IEEE754_H@
251GL_GENERATE_LIMITS_H = @GL_GENERATE_LIMITS_H@ 251GL_GENERATE_LIMITS_H = @GL_GENERATE_LIMITS_H@
252GL_GENERATE_MINI_GMP_H = @GL_GENERATE_MINI_GMP_H@
252GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@ 253GL_GENERATE_STDALIGN_H = @GL_GENERATE_STDALIGN_H@
253GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@ 254GL_GENERATE_STDDEF_H = @GL_GENERATE_STDDEF_H@
254GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@ 255GL_GENERATE_STDINT_H = @GL_GENERATE_STDINT_H@
@@ -1085,7 +1086,6 @@ gamedir = @gamedir@
1085gamegroup = @gamegroup@ 1086gamegroup = @gamegroup@
1086gameuser = @gameuser@ 1087gameuser = @gameuser@
1087gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 = @gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7@ 1088gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7 = @gl_GNULIB_ENABLED_03e0aaad4cb89ca757653bd367a6ccb7@
1088gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9 = @gl_GNULIB_ENABLED_2049e887c7e5308faad27b3f894bb8c9@
1089gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b = @gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b@ 1089gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b = @gl_GNULIB_ENABLED_260941c0e5dc67ec9e87d1fb321c300b@
1090gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@ 1090gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31 = @gl_GNULIB_ENABLED_5264294aa0a5557541b53c8c741f7f31@
1091gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c@ 1091gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c = @gl_GNULIB_ENABLED_6099e9737f757db36c47fa9d9f02e88c@
@@ -2021,15 +2021,22 @@ ifeq (,$(OMIT_GNULIB_MODULE_libgmp))
2021 2021
2022BUILT_SOURCES += $(GMP_H) 2022BUILT_SOURCES += $(GMP_H)
2023 2023
2024ifneq (,$(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.
2025ifneq (,$(GL_GENERATE_GMP_H))
2026gmp.h: $(top_builddir)/config.status 2026gmp.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 $@
2029else 2029else
2030ifneq (,$(GL_GENERATE_GMP_GMP_H))
2031# Build gmp.h as a wrapper for gmp/gmp.h.
2032gmp.h: $(top_builddir)/config.status
2033 echo '#include <gmp/gmp.h>' >$@-t
2034 mv $@-t $@
2035else
2030gmp.h: $(top_builddir)/config.status 2036gmp.h: $(top_builddir)/config.status
2031 rm -f $@ 2037 rm -f $@
2032endif 2038endif
2039endif
2033MOSTLYCLEANFILES += gmp.h gmp.h-t 2040MOSTLYCLEANFILES += gmp.h gmp.h-t
2034 2041
2035EXTRA_DIST += mini-gmp-gnulib.c mini-gmp.c mini-gmp.h 2042EXTRA_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
206autoloads .PHONY: $(lisp)/loaddefs.el 206autoloads .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.
998FILE should be a relative file name. If FILE can't be found,
999return 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.
1045Interactively, FILE is the file at point, and the function prompts
1046for 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.
1672Don'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.
1672The list is displayed in a buffer named `*Bookmark List*'. 1685The 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 74The width will never exceed the actual width of the buffer names,
75but 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.
86This can either be a number (used directly) or a function that
87will be called with the list of buffers and should return a
88number."
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 `>'.
490You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command. 505You can mark buffers with the \\<Buffer-menu-mode-map>`\\[Buffer-menu-mark]' command.
506
491This command deletes and replaces all the previously existing windows 507This command deletes and replaces all the previously existing windows
492in the selected frame." 508in 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).
464POS defaults to point, except when `push-button' is invoked 464POS defaults to point, except when `push-button' is invoked
465interactively as the result of a mouse-event, in which case, the 465interactively as the result of a mouse-event, in which case, the
466mouse event is used. 466mouse event is used.
467
467If there's no button at POS, do nothing and return nil, otherwise 468If there's no button at POS, do nothing and return nil, otherwise
468return t." 469return t.
470
471To get a description of what function will called when pushing a
472butting, 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.
564This is a helper function for `button-describe', in order to be possible to
565use `help-setup-xref'.
566
567Each 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
591When called from Lisp, pass BUTTON-OR-POS as the button to describe, or a
592buffer position where a button is present. If BUTTON-OR-POS is nil, the
593button 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'.
355For example, \"EST\" in New York City, \"PST\" for Los Angeles." 360For 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'.
362For example, \"EDT\" in New York City, \"PDT\" for Los Angeles." 373For 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.
1066If 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.
532For computational purposes, years are 365 days long and months
533are 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
218version. These files should be loaded before showing the customization 218version. These files should be loaded before showing the customization
219buffer that `customize-changed-options' generates.\")\n\n")) 219buffer 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
4846To 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:
1541This means reset VARIABLE. (The argument IGNORED is ignored)." 1541This 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.
1546If 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
688for each command to terminate before running the next command. 688for each command to terminate before running the next command.
689In shell syntax this means separating the individual commands with `;'. 689In shell syntax this means separating the individual commands with `;'.
690 690
691The output appears in the buffer `*Async Shell Command*'." 691The 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
728If COMMAND ends in `&', `;', or `;&', it is executed in the 728If COMMAND ends in `&', `;', or `;&', it is executed in the
729background asynchronously, and the output appears in the buffer 729background 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
731ends in `&', the shell command is executed on each file in parallel. 731ends in `&', the shell command is executed on each file in parallel.
732However, when COMMAND ends in `;' or `;&' then commands are executed 732However, when COMMAND ends in `;' or `;&' then commands are executed
733in the background on each file sequentially waiting for each command 733in 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
737Otherwise, COMMAND is executed synchronously, and the output 737Otherwise, COMMAND is executed synchronously, and the output
738appears in the buffer `*Shell Command Output*'. 738appears in the buffer `shell-command-buffer-name'.
739 739
740This feature does not try to redisplay Dired buffers afterward, as 740This feature does not try to redisplay Dired buffers afterward, as
741there's no telling what files COMMAND may have changed. 741there'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).
953With a prefix argument, kill that many lines starting with the current line. 953With 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
955If you use this command with a prefix argument to kill the line 956If you use this command with a prefix argument to kill the line
956for a file that is a directory, which you have inserted in the 957for a file that is a directory, which you have inserted in the
957Dired buffer as a subdirectory, then it deletes that subdirectory 958Dired buffer as a subdirectory, then it deletes that subdirectory
958from the buffer as well. 959from the buffer as well.
960
959To kill an entire subdirectory \(without killing its line in the 961To kill an entire subdirectory \(without killing its line in the
960parent directory), go to its directory header line and use this 962parent directory), go to its directory header line and use this
961command with a prefix argument (the value does not matter)." 963command with a prefix argument (the value does not matter).
964
965To 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.
126Set this to t if `ls' (or whatever program is specified by 126Set 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
128itself with a trailing @ (usually the case under Ultrix). 128itself with a trailing @ (usually the case under Ultrix and macOS).
129 129
130Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to 130Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
131nil (the default), if it gives `bar@ -> foo', set it to t. 131nil (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.
592If MESSAGE, output the message, too.
593
594If TYPE, it should be a string that says what the information
595type 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.
2050SPEC 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
91SORTFN is a function taking two items of the hierarchy as parameter and
92returning 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
100ACCEPTFN is a function returning non-nil if its parameter (any object)
101should 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
118I.e., if every element of LIST1 also appears in LIST2 and if
119every element of LIST2 also appears in LIST1.
120
121CL-KEYS are key-value pairs just like in `cl-subsetp'. Supported
122keys 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
138PARENTFN is either nil or a function defining the child-to-parent
139relationship: this function takes an item as parameter and should return
140the parent of this item in the hierarchy. If the item has no parent in the
141hierarchy (i.e., it should be a root), the function should return an object
142not accepted by acceptfn (i.e., nil for the default value of acceptfn).
143
144CHILDRENFN is either nil or a function defining the parent-to-children
145relationship: this function takes an item as parameter and should return a
146list of children of this item in the hierarchy.
147
148If both PARENTFN and CHILDRENFN are non-nil, the results of PARENTFN and
149CHILDRENFN are expected to be coherent with each other.
150
151ACCEPTFN is a function returning non-nil if its parameter (any object)
152should be an item of the hierarchy. By default, ACCEPTFN returns non-nil
153if 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
171PARENTFN, 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
179If WRAP is non-nil, allow duplicate items in LIST by wraping each
180item in a cons (id . item). The root's id is 1.
181
182CHILDRENFN is a function (defaults to `cdr') taking LIST as a
183parameter which should return LIST's children (a list). Each
184child is (recursively) passed as a parameter to CHILDRENFN to get
185its own children. Because of this parameter, LIST can be
186anything, 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
204This 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
211SORTFN is a function taking two items of the hierarchy as parameter and
212returning non-nil if the first parameter is lower than the second. By
213default, 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
238Items 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
265A 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
271A 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
279A leaf is an item with no child.
280
281If 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
306ITEM1 is a descendant of ITEM2 if and only if both are items of HIERARCHY
307and 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
322Two equal hierarchies share the same items and the same
323relationships 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
348This function navigates the tree top-down: FUNCTION is first called on item
349and then on each of its children. Results are concatenated in a list.
350
351INDENT is a number (default 0) representing the indentation of ITEM in
352HIERARCHY. FUNC should take 2 argument: the item and its indentation
353level."
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
364This function navigates the tree top-down: FUNCTION is first called on each
365root. To do so, it calls `hierarchy-map-item' on each root
366sequentially. Results are concatenated in a list.
367
368FUNC should take 2 arguments: the item and its indentation level.
369
370INDENT is a number (default 0) representing the indentation of HIERARCHY's
371roots."
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
379This function navigates the tree bottom-up: FUNCTION is first called on
380leafs and the result is passed as parameter when calling FUNCTION on
381parents.
382
383FUNCTION should take 3 parameters: the current item, its indentation
384level (a number), and a list representing the result of applying
385`hierarchy-map-tree' to each child of the item.
386
387INDENT is 0 by default and is passed as second parameter to FUNCTION.
388INDENT is incremented by 1 at each level of the tree.
389
390This function returns the result of applying FUNCTION to ITEM (the first
391root 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
403FUNCTION should take 2 parameters, the current item and its
404indentation level (a number), and should return an item to be
405added 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
445INDENT-STRING defaults to a 2-space string. Indentation is
446multiplied 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
455Clicking the button triggers ACTIONFN. ACTIONFN is a function
456taking an item of HIERARCHY and an indentation value (a number)
457as input. This function is called when an item is clicked. The
458return 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
468Pass LABELFN and ACTIONFN to `hierarchy-labelfn-button' if
469BUTTONP is non-nil. Otherwise, render LABELFN without making it
470a button.
471
472BUTTONP is a function taking an item of HIERARCHY and an
473indentation 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
488Use TO-STRING to convert each element to a string. TO-STRING is
489a function taking an item of HIERARCHY as input and returning a
490string. 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
500TO-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
522LABELFN is a function taking an item of HIERARCHY and an indentation
523level (a number) as input and inserting a string to be displayed in the
524table.
525
526The tabulated list is displayed in BUFFER, or a newly created buffer if
527nil. 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
546LABELFN is a function taking an item of HIERARCHY and an indentation
547value (a number) as parameter and inserting a string to be displayed as a
548node 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
561HIERARCHY and LABELFN are passed unchanged to
562`hierarchy-convert-to-tree-widget'.
563
564The tree widget is displayed in BUFFER, or a newly created buffer if
565nil. 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'."
492SEQUENCE must be a sequence of numbers or markers." 492SEQUENCE 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.
497SEQUENCE must be a sequence of numbers or markers." 498SEQUENCE 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.
43See `erc-encoding-coding-alist'." 43See `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
335Any unsafe characters in the name are replaced with \"!\". The 335Any unsafe characters in the name are replaced with \"!\". The
336filename is downcased." 336filename 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.
2915If there's no letter spec, the input is interpreted as a number of seconds.
2916
2917If input is blank, this function returns nil. Otherwise it
2918returns 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.
2910If no USER argument is specified, list the contents of `erc-ignore-list'." 2951If 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."
3504If S is non-nil, it will be used as the quit reason." 3558If 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."
3531If S is non-nil, it will be used as the quit reason." 3585If 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
4355also `erc-format-nick-function'." 4409also `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.
1655Return nil if LIST is no list or is empty or some test returns nil; 1655Return nil if LIST is no list or is empty or some test returns nil;
1656otherwise, return t." 1656otherwise, 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.
308The 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
2743The 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
2749Each of the elements may be nil, in which case its part in the
2750OpenPGP header will be left out. If all the values are nil,
2751or `message-openpgp-header' is itself nil, the OpenPGP header
2752will 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
2769Header will be constructed as specified in `message-openpgp-header'.
2770
2771Consider 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.
8738DELAY (the numeric prefix) says how many seconds to wait before
8739starting the screenshotting process.
8740
8741The `message-screenshot-command' variable says what command is
8742used 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.
8814This is meant to be used for MIME handlers: Setting the handler
8815for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\"
8816will 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.
69This is only used if `mm-inline-large-images' is set to 74This 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.
1786Each function should take one argument, a buffer position, and return
1787non-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.
1792You can use this command to describe buttons (e.g., the links in a *Help*
1793buffer), editable fields of the customization buffers, etc.
1794
1795Interactively, click on a widget to describe it, or hit RET to describe the
1796widget at point.
1797
1798When called from Lisp, POS may be a buffer position or a mouse position list.
1799
1800Calls each function of the list `describe-widget-functions' in turn, until
1801one 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 1101This is normally a list of dired buffers, but can also be archive and
1088 ;; place point on it. 1102tar 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.
1134This is typically a dired buffer, but may also be a tar/archive buffer.
1135Return the next image file from that buffer.
1136If 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
51This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in 51This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in
52addition to mouse drags." 52addition to mouse drags.
53
54This variable applies only to mouse adjustments in Emacs, not
55selecting 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
425commands reverses the effect of this variable." 425commands 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.
503This can be any number between 1024 and 65535 but must correspond to
504the 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.
511This should be the host name of the machine running XMosaic with CCI
512enabled. 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 823If 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
1453Default to the URL around or before point. The strings in variable
1454`browse-url-mosaic-arguments' are also passed to Mosaic and the
1455program is invoked according to the variable
1456`browse-url-mosaic-program'.
1457
1458When called interactively, if variable `browse-url-new-window-flag' is
1459non-nil, load the document in a new Mosaic window, otherwise use a
1460random existing one. A non-nil interactive prefix argument reverses
1461the effect of `browse-url-new-window-flag'.
1462
1463When called non-interactively, optional second argument NEW-WINDOW is
1464used 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.
1505Default to the URL around or before point.
1506
1507This function only works for XMosaic version 2.5 or later. You must
1508select `CCI' from XMosaic's File menu, set the CCI Port Address to the
1509value of variable `browse-url-CCI-port', and enable `Accept requests'.
1510
1511When called interactively, if variable `browse-url-new-window-flag' is
1512non-nil, load the document in a new browser window, otherwise use a
1513random existing one. A non-nil interactive prefix argument reverses
1514the effect of `browse-url-new-window-flag'.
1515
1516When called non-interactively, optional second argument NEW-WINDOW is
1517used 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.
282This is meant to be used for MIME handlers or command line use.
283
284Setting the handler for \"text/x-uri;\" to
285\"emacs -f eww-browse %u\" will then start up Emacs and call eww
286to browse the url.
287
288This can also be used on the command line directly:
289
290 emacs -f eww-browse https://gnu.org
291
292will 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.
282If the input doesn't look like an URL or a domain name, the 300If 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 891If connection property \"direct-async-process\" is non-nil, an
890 (with-parsed-tramp-file-name (expand-file-name default-directory) nil 892alternative 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.
2790STDERR can also be a file name." 2790STDERR 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 2792implementation 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.
294The value of this variable is checked as part of loading Outline mode. 296The value of this variable is checked as part of loading Outline mode.
295After that, changing the prefix key requires manipulating keymaps." 297After 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
6499in subdirectories too." 6500in 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
1176result in `project-list-file'. Announce the project's removal 1178result in `project-list-file'. Announce the project's removal
1177from the list." 1179from 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.
48Each element looks like (FILENAME . POSITION); 47Each 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. 178Put filename and point in a cons box and then cons that onto the
180 ;; Otherwise, just delete that file from the alist. 179front 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 180Otherwise, 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.
3435This option specifies how to resolve the conflict where a new command 3443This option specifies how to resolve the conflict where a new command
3436wants to direct its output to the buffer `*Async Shell Command*', 3444wants to direct its output to the buffer `shell-command-buffer-name-async',
3437but this buffer is already taken by another running shell command. 3445but this buffer is already taken by another running shell command.
3438 3446
3439The value `confirm-kill-process' is used to ask for confirmation before 3447The value `confirm-kill-process' is used to ask for confirmation before
@@ -3585,14 +3593,14 @@ whose `car' is BUFFER."
3585Like `shell-command', but adds `&' at the end of COMMAND 3593Like `shell-command', but adds `&' at the end of COMMAND
3586to execute it asynchronously. 3594to execute it asynchronously.
3587 3595
3588The output appears in the buffer `*Async Shell Command*'. 3596The output appears in the buffer `shell-command-buffer-name-async'.
3589That buffer is in shell mode. 3597That buffer is in shell mode.
3590 3598
3591You can configure `async-shell-command-buffer' to specify what to do 3599You can configure `async-shell-command-buffer' to specify what to do
3592when the `*Async Shell Command*' buffer is already taken by another 3600when the `shell-command-buffer-name-async' buffer is already taken by another
3593running shell command. To run COMMAND without displaying the output 3601running shell command. To run COMMAND without displaying the output
3594in a window you can configure `display-buffer-alist' to use the action 3602in 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
3597In Elisp, you will often be better served by calling `start-process' 3605In Elisp, you will often be better served by calling `start-process'
3598directly, since it offers more control and does not impose the use of 3606directly, 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
3628directory in the prompt. 3636directory in the prompt.
3629 3637
3630If COMMAND ends in `&', execute it asynchronously. 3638If COMMAND ends in `&', execute it asynchronously.
3631The output appears in the buffer `*Async Shell Command*'. 3639The output appears in the buffer `shell-command-buffer-name-async'.
3632That buffer is in shell mode. You can also use 3640That 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
3635Otherwise, COMMAND is executed synchronously. The output appears in 3643Otherwise, COMMAND is executed synchronously. The output appears in
3636the buffer `*Shell Command Output*'. If the output is short enough to 3644the buffer `shell-command-buffer-name'. If the output is short enough to
3637display in the echo area (which is determined by the variables 3645display 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
3639there, but it is nonetheless available in buffer `*Shell Command 3647there, 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.
3911Normally display output (if any) in temp buffer `*Shell Command Output*'; 3919Normally display output (if any) in temp buffer `shell-command-buffer-name';
3912Prefix arg means replace the region with it. Return the exit code of 3920Prefix arg means replace the region with it. Return the exit code of
3913COMMAND. 3921COMMAND.
3914 3922
@@ -3927,7 +3935,7 @@ in the echo area or in a buffer.
3927If the output is short enough to display in the echo area 3935If 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.
3930Otherwise it is displayed in the buffer `*Shell Command Output*'. 3938Otherwise it is displayed in the buffer `shell-command-buffer-name'.
3931The output is available in that buffer in both cases. 3939The output is available in that buffer in both cases.
3932 3940
3933If there is output and an error, a message about the error 3941If 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
3937command's output. If the value is a buffer or buffer name, 3945command's output. If the value is a buffer or buffer name,
3938erase that buffer and insert the output there; a non-nil value of 3946erase 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.
3940If the value is nil, use the buffer `*Shell Command Output*'. 3948If the value is nil, use the buffer `shell-command-buffer-name'.
3941Any other non-nil value means to insert the output in the 3949Any other non-nil value means to insert the output in the
3942current buffer after START. 3950current 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.
135A prefix argument of zero says to wrap around zero words---that is, nothing. 135A prefix argument of zero says to wrap around zero words---that is, nothing.
136This is a way of overriding the use of a highlighted region.") 136This 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 @@
421Has no effect if `global-so-long-mode' is not enabled.") 421Has 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
503This affects the behavior of `global-so-long-mode'. 503This affects the behaviour of `global-so-long-mode'.
504 504
505We treat invisible buffers differently from displayed buffers because, in 505We treat invisible buffers differently from displayed buffers because, in
506cases where a library is using a buffer for behind-the-scenes processing, 506cases 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.
609The value `longlines-mode' causes that minor mode to be enabled. See 609The value `longlines-mode' causes that minor mode to be enabled. See
610longlines.el for more details. 610longlines.el for more details.
611 611
612Each action likewise determines the behavior of `so-long-revert'. 612Each action likewise determines the behaviour of `so-long-revert'.
613 613
614If the value is nil, or not defined in `so-long-action-alist', then no action 614If the value is nil, or not defined in `so-long-action-alist', then no action
615will be taken." 615will 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'
756or `so-long-minor-mode'. If `so-long-revert' is subsequently invoked, then the 756or `so-long-minor-mode'. If `so-long-revert' is subsequently invoked, then the
757disabled modes are re-enabled by calling them with the numeric argument 1. 757disabled 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
761Please submit bug reports to recommend additional modes for this list, whether 761Please submit bug reports to recommend additional modes for this list, whether
762they are in Emacs core, GNU ELPA, or elsewhere." 762they are in Emacs core, GNU ELPA, or elsewhere."
@@ -781,9 +781,20 @@ If `so-long-revert' is subsequently invoked, then the variables are restored
781to their original states. 781to their original states.
782 782
783The combination of `line-move-visual' (enabled) and `truncate-lines' (disabled) 783The combination of `line-move-visual' (enabled) and `truncate-lines' (disabled)
784is important for maximizing responsiveness when moving vertically within an 784is important for maximising responsiveness when moving vertically within an
785extremely long line, as otherwise the full length of the line may need to be 785extremely long line, as otherwise the full length of the line may need to be
786scanned to find the next position." 786scanned to find the next position.
787
788Bidirectional text display -- especially handling the large quantities of
789nested parentheses which are liable to occur in minified programming code --
790can be very expensive for extremely long lines, and so this support is disabled
791by default (insofar as is supported; in particular `bidi-inhibit-bpa' is not
792available in Emacs versions < 27). For more information refer to info node
793`(emacs) Bidirectional Editing' and info node `(elisp) Bidirectional Display'.
794
795Buffers are made read-only by default to prevent potentially-slow editing from
796occurring inadvertantly, as buffers with excessively long lines are likely not
797intended 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
988Face `so-long-mode-line-active' is used while mitigation is active, and 999Face `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
991Not displayed when `so-long-mode' is enabled, as the major mode construct 1002Not 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
1204Use \\[so-long-commentary] for more information. 1217Use \\[so-long-commentary] for more information.
1205 1218
1206Use \\[so-long-customize] to configure the behavior." 1219Use \\[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."
1251This advice acts before `so-long-mode', with the previous mode still active." 1264This 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
1394This special-case code will ultimately be removed from Emacs, as it exists to 1407This special-case code will ultimately be removed from Emacs, as it exists to
1395deal with a deprecated feature; but until then we need to replicate it in order 1408deal with a deprecated feature; but until then we need to replicate it in order
1396to inhibit our own behavior in the presence of a header comment `mode' 1409to inhibit our own behaviour in the presence of a header comment `mode'
1397declaration. 1410declaration.
1398 1411
1399If a file-local mode is detected in the header comment, then we call the 1412If 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
1528major mode to `so-long-mode' by this point, that protection is insufficient 1541major mode to `so-long-mode' by this point, that protection is insufficient
1529and so we need to perform our own test. 1542and so we need to perform our own test.
1530 1543
1531We likewise need to support an equivalent of the `no-mode' behavior in 26.1+ 1544We likewise need to support an equivalent of the `no-mode' behaviour in 26.1+
1532to ensure that `so-long-mode-revert' will not restore a file-local mode again 1545to ensure that `so-long-mode-revert' will not restore a file-local mode again
1533after it has already reverted to the original mode. 1546after 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
1666Many Emacs modes struggle with buffers which contain excessively long lines, 1679Many Emacs modes struggle with buffers which contain excessively long lines,
1667and may consequently cause unacceptable performance issues. 1680and 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
1676Use \\[so-long-commentary] for more information. 1689Use \\[so-long-commentary] for more information.
1677 1690
1678Use \\[so-long-customize] to configure the behavior." 1691Use \\[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.
893KEYS should be a string in the format returned by commands such 897KEYS 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.
927FILE should be a relative file name. If FILE can't be found,
928return 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.
191If nil, named branch will be created.
192If t, bookmark will be created.
193If `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.
639Variable `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.
1389This 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
289It's a list containing some or all of the following values: 290It'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.
582Displays a buffer with information about the widget (e.g., its actions) as well
583as a link to browse all the properties of the widget.
584
585This command resolves the indirection of widgets running the action of its
586parents, so the real action executed can be known.
587
588When called from Lisp, pass WIDGET-OR-POS as the widget to describe,
589or a buffer position where a widget is present. If WIDGET-OR-POS is nil,
590the 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.
628Follow 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.
37The function takes three arguments, WINDOW, ACTION and TYPES. 37The function takes three arguments, WINDOW, ACTION and TYPES.
38WINDOW is where the mouse is when the function is called. WINDOW may be a 38WINDOW 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
2dnl Copyright (C) 2002-2004, 2006-2007, 2009-2020 Free Software Foundation, 2dnl Copyright (C) 2002-2004, 2006-2007, 2009-2020 Free Software Foundation,
3dnl Inc. 3dnl Inc.
4dnl This file is free software; the Free Software Foundation 4dnl 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.
51AC_DEFUN([gl_PREREQ_ALLOCA], [:]) 51AC_DEFUN([gl_PREREQ_ALLOCA], [:])
52 52
53# This works around a bug in autoconf <= 2.68. 53m4_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
103AC_DEFINE_UNQUOTED(STACK_DIRECTION, $ac_cv_c_stack_direction) 106AC_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
2dnl Copyright (C) 2007-2020 Free Software Foundation, Inc. 2dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
3dnl This file is free software; the Free Software Foundation 3dnl This file is free software; the Free Software Foundation
4dnl gives unlimited permission to copy and/or distribute it, 4dnl gives unlimited permission to copy and/or distribute it,
@@ -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.
3dnl Copyright 2020 Free Software Foundation, Inc. 3dnl Copyright 2020 Free Software Foundation, Inc.
4dnl This file is free software; the Free Software Foundation 4dnl 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;
2959static void 2956static void
2960setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes) 2957setup_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. */
205extern void *_malloc_internal (size_t); 202extern void *_malloc_internal (size_t);
206extern void *_realloc_internal (void *, size_t); 203extern void *_realloc_internal (void *, size_t);
207extern void _free_internal (void *); 204extern 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. */
899typedef char *untagged_ptr; 899typedef char *untagged_ptr;
900typedef uintptr_t Lisp_Word_tag; 900typedef 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
1014INLINE Lisp_Object 1005INLINE Lisp_Object
1015make_lisp_symbol (struct Lisp_Symbol *sym) 1006make_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. */
4826INLINE void
4827__lsan_ignore_object (void const *p)
4828{
4829}
4830#endif
4831
4840extern void xputenv (const char *); 4832extern void xputenv (const char *);
4841 4833
4842extern char *egetenv_internal (const char *, ptrdiff_t); 4834extern 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
202void
203ns_image_set_smoothing (void *img, bool smooth)
204{
205 [(EmacsImage *)img setSmoothing:smooth];
206}
207
202unsigned long 208unsigned long
203ns_get_pixel (void *img, int x, int y) 209ns_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);
1200extern int ns_image_height (void *img); 1202extern int ns_image_height (void *img);
1201extern void ns_image_set_size (void *img, int width, int height); 1203extern void ns_image_set_size (void *img, int width, int height);
1202extern void ns_image_set_transform (void *img, double m[3][3]); 1204extern void ns_image_set_transform (void *img, double m[3][3]);
1205extern void ns_image_set_smoothing (void *img, bool smooth);
1203extern unsigned long ns_get_pixel (void *img, int x, int y); 1206extern unsigned long ns_get_pixel (void *img, int x, int y);
1204extern void ns_put_pixel (void *img, int x, int y, unsigned long argb); 1207extern void ns_put_pixel (void *img, int x, int y, unsigned long argb);
1205extern void ns_set_alpha (void *img, int x, int y, unsigned char a); 1208extern 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
3Copyright 2017-2020 Free Software Foundation, Inc.
4
5This file is part of GNU Emacs.
6
7GNU Emacs is free software: you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation, either version 3 of the License, or (at
10your option) any later version.
11
12GNU Emacs is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along 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
41INLINE_HEADER_BEGIN
42
43/* Return a copy of P, with bounds narrowed to [P, P + N). */
44#ifdef __CHKP__
45INLINE void *
46ptr_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
77INLINE_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 *);
993static void handle_stop_backwards (struct it *, ptrdiff_t); 993static void handle_stop_backwards (struct it *, ptrdiff_t);
994static void unwind_with_echo_area_buffer (Lisp_Object); 994static void unwind_with_echo_area_buffer (Lisp_Object);
995static Lisp_Object with_echo_area_buffer_unwind_data (struct window *); 995static Lisp_Object with_echo_area_buffer_unwind_data (struct window *);
996static bool current_message_1 (ptrdiff_t, Lisp_Object); 996static bool current_message_1 (void *, Lisp_Object);
997static bool truncate_message_1 (ptrdiff_t, Lisp_Object); 997static bool truncate_message_1 (void *, Lisp_Object);
998static void set_message (Lisp_Object); 998static void set_message (Lisp_Object);
999static bool set_message_1 (ptrdiff_t, Lisp_Object); 999static bool set_message_1 (void *, Lisp_Object);
1000static bool display_echo_area_1 (ptrdiff_t, Lisp_Object); 1000static bool display_echo_area_1 (void *, Lisp_Object);
1001static bool resize_mini_window_1 (ptrdiff_t, Lisp_Object); 1001static bool resize_mini_window_1 (void *, Lisp_Object);
1002static void unwind_redisplay (void); 1002static void unwind_redisplay (void);
1003static void extend_face_to_end_of_line (struct it *); 1003static void extend_face_to_end_of_line (struct it *);
1004static intmax_t message_log_check_duplicate (ptrdiff_t, ptrdiff_t); 1004static intmax_t message_log_check_duplicate (ptrdiff_t, ptrdiff_t);
@@ -11278,8 +11278,8 @@ ensure_echo_area_buffers (void)
11278 11278
11279static bool 11279static bool
11280with_echo_area_buffer (struct window *w, int which, 11280with_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
11570static bool 11569static bool
11571display_echo_area_1 (ptrdiff_t a1, Lisp_Object a2) 11570display_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
11632static bool 11630static bool
11633resize_mini_window_1 (ptrdiff_t a1, Lisp_Object exactly) 11631resize_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
11782static bool 11778static bool
11783current_message_1 (ptrdiff_t a1, Lisp_Object a2) 11779current_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
11868static bool 11864static bool
11869truncate_message_1 (ptrdiff_t nchars, Lisp_Object a2) 11865truncate_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
11921static bool 11918static bool
11922set_message_1 (ptrdiff_t a1, Lisp_Object string) 11919set_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
67In case you want to use the symbol name of a test as selector, you can
68use it directly:
69
70 make <filename> SELECTOR='test-foo-remote'
71
67Note that although the test files are always compiled (unless they set 72Note that although the test files are always compiled (unless they set
68no-byte-compile), the source files will be run when expensive or 73no-byte-compile), the source files will be run when expensive or
69unstable tests are involved, to give nicer backtraces. To run the 74unstable 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
13include-default
14
15
16# CN=No Expiry
17D0: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
200E: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
23D4: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
264F: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
255Edebug 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
943primary 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
965clashes (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
1005backtracking (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.
35Mostly, 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.
56If optional INTERACTIVE is non-nil, allow questions to the user in case of
57key problems.
58This fixture temporarily unsets GPG_AGENT_INFO to enable passphrase tests,
59which will neither work with gpgsm nor GnuPG 2.1 any longer, I guess.
60Actually, I'm not sure why people would want to cache passwords in Emacs
61instead 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.
93Optionally, 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
97From: %s
98Subject: 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.
120Pass 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.
172For 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
178For 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
189In 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.
489If optional CHECKSIG is non-nil, it must be a number, and a signature check is
490performed; the number indicates how many signatures are expected.
491If optional CHECKPLAIN is non-nil, the expected plaintext should be obtained
492via decryption.
493If optional ENC-KEYS is non-nil, it is a list of pairs of encryption keys (for
494OpenPGP and S/SMIME) expected in `epg-debug-buffer'.
495If optional EXPECTFAIL is non-nil, a decryption failure is expected.
496Pass 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.
553Args METHOD, TO, FROM, CHECKSIG are passed to mml-secure-test-en-decrypt.
554JL-PASSPHRASE is fixed as return value for `read-passwd',
555boolean DO-CACHE determines whether to cache the passphrase.
556If optional ENC-KEYS is non-nil, it is a list of encryption keys expected
557in `epg-debug-buffer'.
558If 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.
571In 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.
581In 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.
594In 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.
610In 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.
625In 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.
649In 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.
665In 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.
682In 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.
716Use 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.
786With 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.
807In this test, a key is used that requires the passphrase \"Passphrase\".
808In 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.
827In this test, a key is used that requires the passphrase \"Passphrase\".
828In the first decryption this passphrase is hardcoded, but caching disabled.
829So 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