[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/zach-soc-funcall-from-bytecode b417cf0 1/6: Merge branch 'master
|
From: |
Rocky Bernstein |
|
Subject: |
feature/zach-soc-funcall-from-bytecode b417cf0 1/6: Merge branch 'master' into feature/soc-bytecode-in-traceback-specbinding |
|
Date: |
Fri, 26 Jun 2020 11:54:44 -0400 (EDT) |
branch: feature/zach-soc-funcall-from-bytecode
commit b417cf03c06f0924752b1dc193726ffc94432f81
Merge: ef71dc4 5467aac
Author: Zach Shaftel <zshaftel@gmail.com>
Commit: Zach Shaftel <zshaftel@gmail.com>
Merge branch 'master' into feature/soc-bytecode-in-traceback-specbinding
---
admin/authors.el | 6 +-
admin/charsets/cp51932.awk | 13 +-
admin/charsets/eucjp-ms.awk | 14 +-
admin/notes/git-workflow | 36 +-
build-aux/config.guess | 9 +-
build-aux/config.sub | 4 +-
build-aux/gitlog-to-changelog | 4 +-
build-aux/update-copyright | 4 +-
doc/emacs/building.texi | 32 +
doc/emacs/calendar.texi | 4 +-
doc/emacs/custom.texi | 4 +-
doc/emacs/dired.texi | 6 +
doc/emacs/frames.texi | 57 +-
doc/emacs/help.texi | 52 +-
doc/emacs/killing.texi | 2 +
doc/emacs/misc.texi | 14 +-
doc/emacs/modes.texi | 2 +-
doc/emacs/mule.texi | 84 +-
doc/emacs/package.texi | 38 +-
doc/emacs/search.texi | 22 +-
doc/emacs/windows.texi | 12 +-
doc/lispintro/emacs-lisp-intro.texi | 5 +-
doc/lispref/control.texi | 1 +
doc/lispref/display.texi | 6 +-
doc/lispref/elisp.texi | 2 +-
doc/lispref/eval.texi | 21 +-
doc/lispref/files.texi | 5 +
doc/lispref/frames.texi | 10 +-
doc/lispref/lists.texi | 34 +-
doc/lispref/modes.texi | 17 +-
doc/lispref/objects.texi | 94 +--
doc/lispref/os.texi | 16 +-
doc/lispref/processes.texi | 16 +
doc/lispref/searching.texi | 10 +-
doc/lispref/sequences.texi | 25 +-
doc/lispref/strings.texi | 11 +-
doc/lispref/text.texi | 3 +
doc/lispref/tips.texi | 8 +
doc/misc/cc-mode.texi | 25 +
doc/misc/efaq.texi | 26 +-
doc/misc/emacs-mime.texi | 2 +-
doc/misc/eshell.texi | 3 +
doc/misc/texinfo.tex | 99 ++-
doc/misc/tramp.texi | 47 +-
etc/NEWS | 188 ++++-
etc/NEWS.27 | 32 +-
etc/TODO | 64 +-
etc/themes/misterioso-theme.el | 7 +
lib-src/etags.c | 2 +-
lib/attribute.h | 215 +++++
lib/careadlinkat.c | 38 +-
lib/dirent.in.h | 10 +-
lib/explicit_bzero.c | 18 +-
lib/gnulib.mk.in | 10 +
lib/ieee754.in.h | 4 +-
lib/limits.in.h | 23 +-
lib/nstrftime.c | 9 +-
lib/stdio.in.h | 10 +-
lib/stdlib.in.h | 10 +-
lib/string.in.h | 36 +-
lib/warn-on-use.h | 21 +-
lisp/abbrev.el | 6 +-
lisp/apropos.el | 21 +-
lisp/arc-mode.el | 28 +-
lisp/bookmark.el | 8 +-
lisp/button.el | 12 +-
lisp/calc/calc-comb.el | 4 +-
lisp/calc/calc-mtx.el | 2 +-
lisp/calculator.el | 12 +-
lisp/calendar/cal-bahai.el | 4 +-
lisp/calendar/cal-julian.el | 22 +-
lisp/cedet/data-debug.el | 38 +-
lisp/cedet/ede.el | 7 +-
lisp/cedet/semantic/wisent/comp.el | 4 +-
lisp/cedet/semantic/wisent/wisent.el | 9 +-
lisp/cus-edit.el | 12 +-
lisp/cus-start.el | 11 +-
lisp/desktop.el | 39 +-
lisp/dired-aux.el | 7 +-
lisp/dired.el | 4 +-
lisp/display-fill-column-indicator.el | 8 +-
lisp/dnd.el | 30 +-
lisp/doc-view.el | 4 +-
lisp/dom.el | 6 +
lisp/emacs-lisp/bindat.el | 2 +-
lisp/emacs-lisp/byte-opt.el | 2 +-
lisp/emacs-lisp/byte-run.el | 11 +-
lisp/emacs-lisp/bytecomp.el | 8 +
lisp/emacs-lisp/check-declare.el | 4 +-
lisp/emacs-lisp/cl-indent.el | 36 +-
lisp/emacs-lisp/cl-macs.el | 15 +-
lisp/emacs-lisp/edebug.el | 53 +-
lisp/emacs-lisp/eieio.el | 38 +-
lisp/emacs-lisp/eldoc.el | 5 +
lisp/emacs-lisp/float-sup.el | 2 +-
lisp/emacs-lisp/lisp-mode.el | 13 +-
lisp/emacs-lisp/package.el | 59 +-
lisp/emacs-lisp/pcase.el | 52 +-
lisp/emacs-lisp/syntax.el | 97 ++-
lisp/emacs-lisp/timer-list.el | 132 ++--
lisp/emulation/viper.el | 1 -
lisp/env.el | 8 +-
lisp/erc/erc-backend.el | 3 +-
lisp/eshell/eshell.el | 22 +-
lisp/ffap.el | 13 +-
lisp/fileloop.el | 33 +-
lisp/files.el | 37 +-
lisp/frameset.el | 12 +-
lisp/gnus/gmm-utils.el | 6 +-
lisp/gnus/gnus-art.el | 14 +-
lisp/gnus/gnus-registry.el | 36 +-
lisp/gnus/gnus-sum.el | 6 +-
lisp/gnus/message.el | 6 +-
lisp/help-fns.el | 8 +-
lisp/help-mode.el | 13 +-
lisp/hi-lock.el | 20 +-
lisp/htmlfontify.el | 3 -
lisp/ido.el | 19 +-
lisp/ielm.el | 31 +-
lisp/image-mode.el | 20 +-
lisp/info.el | 26 +-
lisp/isearch.el | 7 +-
lisp/jit-lock.el | 10 +-
lisp/json.el | 576 +++++++-------
lisp/jsonrpc.el | 104 ++-
lisp/language/japanese.el | 10 +-
lisp/language/lao-util.el | 16 +-
lisp/language/tibet-util.el | 14 +-
lisp/language/tibetan.el | 8 +-
lisp/ldefs-boot.el | 90 ++-
lisp/mail/qp.el | 2 +-
lisp/mail/rfc2368.el | 2 +-
lisp/menu-bar.el | 4 +-
lisp/mouse.el | 12 +-
lisp/net/browse-url.el | 290 +++++--
lisp/net/eww.el | 36 +-
lisp/net/hmac-md5.el | 40 +-
lisp/net/nsm.el | 1 +
lisp/net/puny.el | 2 +-
lisp/net/shr.el | 84 +-
lisp/net/tramp-adb.el | 32 +-
lisp/net/tramp-archive.el | 7 +-
lisp/net/tramp-cache.el | 61 +-
lisp/net/tramp-cmds.el | 12 +-
lisp/net/tramp-gvfs.el | 5 +-
lisp/net/tramp-rclone.el | 13 +-
lisp/net/tramp-sh.el | 43 +-
lisp/net/tramp.el | 32 +-
lisp/net/webjump.el | 5 +-
lisp/obsolete/ledit.el | 157 ----
lisp/obsolete/levents.el | 292 -------
lisp/obsolete/lmenu.el | 445 -----------
lisp/obsolete/lucid.el | 211 -----
lisp/{mail => obsolete}/metamail.el | 1 +
lisp/obsolete/old-whitespace.el | 801 -------------------
lisp/org/org-agenda.el | 5 +-
lisp/password-cache.el | 3 +-
lisp/play/animate.el | 4 +-
lisp/play/dissociate.el | 2 +-
lisp/printing.el | 2 -
lisp/progmodes/autoconf.el | 2 +-
lisp/progmodes/cc-align.el | 32 +
lisp/progmodes/cc-engine.el | 23 +-
lisp/progmodes/cc-fonts.el | 78 ++
lisp/progmodes/cc-langs.el | 25 +-
lisp/progmodes/cc-mode.el | 31 +-
lisp/progmodes/cc-vars.el | 1 +
lisp/progmodes/ebnf2ps.el | 4 -
lisp/progmodes/elisp-mode.el | 41 +-
lisp/progmodes/flymake.el | 12 +-
lisp/progmodes/glasses.el | 11 +-
lisp/progmodes/project.el | 183 +++--
lisp/progmodes/python.el | 21 +-
lisp/progmodes/vhdl-mode.el | 2 +-
lisp/progmodes/which-func.el | 97 +--
lisp/progmodes/xref.el | 21 +-
lisp/replace.el | 35 +-
lisp/saveplace.el | 4 +-
lisp/simple.el | 16 +-
lisp/subr.el | 24 +-
lisp/t-mouse.el | 2 +-
lisp/tab-bar.el | 38 +-
lisp/tab-line.el | 6 +-
lisp/tar-mode.el | 20 +-
lisp/term/bobcat.el | 1 +
lisp/term/cygwin.el | 2 +-
lisp/term/konsole.el | 2 +-
lisp/term/linux.el | 2 +-
lisp/term/vt100.el | 2 +-
lisp/term/vt200.el | 2 +
lisp/term/x-win.el | 10 +-
lisp/textmodes/bibtex.el | 110 +--
lisp/textmodes/css-mode.el | 18 +-
lisp/textmodes/sgml-mode.el | 6 +-
lisp/vc/ediff-vers.el | 25 +-
lisp/vc/vc-dir.el | 36 +
lisp/vc/vc-git.el | 4 +
lisp/vc/vc-hooks.el | 2 +-
lisp/version.el | 8 +-
lisp/w32-vars.el | 14 +-
lisp/window.el | 36 +-
lisp/xml.el | 14 +-
m4/explicit_bzero.m4 | 1 +
m4/gnulib-common.m4 | 229 +++++-
m4/gnulib-comp.m4 | 2 +
m4/manywarnings.m4 | 24 +-
src/alloc.c | 134 ++--
src/bignum.h | 3 +-
src/buffer.c | 40 +-
src/bytecode.c | 28 +-
src/character.h | 42 +-
src/conf_post.h | 109 +--
src/data.c | 20 +-
src/dispnew.c | 2 +-
src/editfns.c | 2 +-
src/emacs-module.c | 2 +-
src/emacs-module.h.in | 16 +-
src/emacs.c | 5 +
src/eval.c | 62 +-
src/fns.c | 109 +--
src/gtkutil.c | 9 +-
src/intervals.c | 3 +-
src/keyboard.c | 4 +-
src/lisp.h | 42 +-
src/lread.c | 26 +-
src/nsterm.m | 51 +-
src/search.c | 10 +-
src/systhread.h | 12 +-
src/term.c | 2 +-
src/textprop.c | 12 +-
src/thread.c | 9 +-
src/w32.c | 12 +-
src/xdisp.c | 68 +-
src/xfaces.c | 6 +-
src/xfns.c | 8 +-
src/xmenu.c | 2 +-
test/lisp/arc-mode-tests.el | 2 +-
test/lisp/calc/calc-tests.el | 52 ++
test/lisp/calendar/cal-julian-tests.el | 72 ++
test/lisp/calendar/icalendar-tests.el | 13 +-
test/lisp/calendar/iso8601-tests.el | 31 +
test/lisp/calendar/parse-time-tests.el | 2 +-
test/lisp/cedet/semantic-utest-fmt.el | 4 +-
test/lisp/cedet/semantic-utest-ia.el | 7 +-
test/lisp/cedet/semantic-utest.el | 32 +-
test/lisp/cedet/srecode-utest-getset.el | 3 +-
test/lisp/cedet/srecode-utest-template.el | 2 +-
test/lisp/comint-tests.el | 2 +-
test/lisp/custom-resources/custom--test-theme.el | 2 +
test/lisp/dabbrev-tests.el | 2 +-
test/lisp/dom-tests.el | 7 +
test/lisp/electric-tests.el | 18 +
test/lisp/emacs-lisp/bindat-tests.el | 16 +
test/lisp/emacs-lisp/bytecomp-tests.el | 2 +-
test/lisp/emacs-lisp/check-declare-tests.el | 116 +++
test/lisp/emacs-lisp/cl-macs-tests.el | 13 +-
.../edebug-resources/edebug-test-code.el | 2 +-
.../eieio-tests/eieio-test-methodinvoke.el | 58 +-
.../emacs-lisp/eieio-tests/eieio-test-persist.el | 2 +-
test/lisp/emacs-lisp/ert-x-tests.el | 2 +-
.../faceup-resources/faceup-test-mode.el | 2 +-
.../faceup-test-this-file-directory.el | 2 +-
.../emacs-lisp/faceup-tests/faceup-test-basics.el | 2 +-
.../emacs-lisp/faceup-tests/faceup-test-files.el | 2 +-
.../float-sup-tests.el} | 24 +-
test/lisp/emacs-lisp/nadvice-tests.el | 2 +-
.../newer-versions/new-pkg-1.0.el | 2 +-
.../newer-versions/simple-single-1.4.el | 2 +-
.../package-resources/simple-depend-1.0.el | 2 +-
.../package-resources/simple-single-1.3.el | 2 +-
.../package-resources/simple-two-depend-1.1.el | 2 +-
test/lisp/emacs-lisp/package-tests.el | 26 +-
test/lisp/emacs-lisp/pcase-tests.el | 2 +-
test/lisp/emacs-lisp/seq-tests.el | 10 +-
test/lisp/emacs-lisp/shadow-resources/p1/foo.el | 2 +-
test/lisp/emacs-lisp/shadow-resources/p2/FOO.el | 2 +-
test/lisp/emacs-lisp/subr-x-tests.el | 2 +-
test/lisp/emacs-lisp/syntax-tests.el | 67 ++
test/lisp/emacs-lisp/text-property-search-tests.el | 2 +-
test/lisp/emulation/viper-tests.el | 2 +-
test/lisp/erc/erc-track-tests.el | 6 +-
test/lisp/eshell/em-hist-tests.el | 2 +-
test/lisp/eshell/em-ls-tests.el | 2 +-
test/lisp/eshell/esh-opt-tests.el | 2 +-
test/lisp/files-tests.el | 36 +
test/lisp/gnus/gnus-tests.el | 2 +-
test/lisp/help-mode-tests.el | 169 ++++
test/lisp/imenu-tests.el | 2 +-
test/lisp/info-xref-tests.el | 2 +-
test/lisp/jit-lock-tests.el | 2 +-
test/lisp/json-tests.el | 867 +++++++++++++++++----
test/lisp/mail/qp-tests.el | 74 ++
test/lisp/mail/rfc2368-tests.el | 39 +
test/lisp/man-tests.el | 4 +-
test/lisp/net/hmac-md5-tests.el | 80 ++
test/lisp/net/puny-tests.el | 21 +
test/lisp/net/tramp-tests.el | 142 ++--
test/lisp/net/webjump-tests.el | 73 ++
test/lisp/password-cache-tests.el | 14 +-
test/lisp/play/animate-tests.el | 56 ++
.../dissociate-tests.el} | 28 +-
test/lisp/progmodes/autoconf-tests.el | 55 ++
test/lisp/progmodes/cc-mode-tests.el | 33 +-
test/lisp/progmodes/etags-tests.el | 2 +-
test/lisp/progmodes/f90-tests.el | 2 +-
test/lisp/progmodes/glasses-tests.el | 101 +++
test/lisp/progmodes/ps-mode-tests.el | 2 +-
test/lisp/progmodes/python-tests.el | 11 +-
test/lisp/progmodes/ruby-mode-tests.el | 2 +-
test/lisp/progmodes/subword-tests.el | 2 +-
test/lisp/progmodes/tcl-tests.el | 2 +-
test/lisp/progmodes/xref-tests.el | 2 +-
test/lisp/replace-tests.el | 2 +-
test/lisp/shadowfile-tests.el | 20 +-
test/lisp/simple-tests.el | 11 +-
test/lisp/startup-tests.el | 47 ++
test/lisp/subr-tests.el | 2 +-
test/lisp/tar-mode-tests.el | 3 +-
test/lisp/thingatpt-tests.el | 2 +-
test/lisp/vc/add-log-tests.el | 12 +-
test/lisp/vc/diff-mode-tests.el | 2 +
test/lisp/vc/ediff-ptch-tests.el | 2 +-
test/lisp/vc/smerge-mode-tests.el | 2 +
test/lisp/vc/vc-hg-tests.el | 2 +-
test/lisp/vc/vc-tests.el | 2 +-
test/lisp/{gnus/gnus-tests.el => version-tests.el} | 22 +-
test/lisp/xml-tests.el | 12 +-
test/manual/indent/css-mode.css | 4 +
test/manual/indent/less-css-mode.less | 10 +
test/manual/indent/scss-mode.scss | 4 +
test/src/buffer-tests.el | 6 +
test/src/fns-tests.el | 34 +-
332 files changed, 6483 insertions(+), 4512 deletions(-)
diff --git a/admin/authors.el b/admin/authors.el
index 13b203b..dc57c0a 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -365,7 +365,7 @@ Changes to files matching one of the regexps in this list
are not listed.")
"lib/stdarg.in.h" "lib/stdbool.in.h"
"unidata/bidimirror.awk" "unidata/biditype.awk"
"split-man" "Xkeymap.txt" "ms-7bkermit" "ulimit.hack"
- "gnu-hp300" "refcard.bit" "ledit.l" "forms.README" "forms-d2.dat"
+ "gnu-hp300" "refcard.bit" "forms.README" "forms-d2.dat"
"CXTERM-DIC/PY.tit" "CXTERM-DIC/ZIRANMA.tit"
"CXTERM-DIC/CTLau.tit" "CXTERM-DIC/CTLauB.tit"
"copying.paper" "celibacy.1" "condom.1" "echo.msg" "sex.6"
@@ -609,7 +609,7 @@ Changes to files in this list are not listed.")
;; No longer distributed: lselect.el.
("Lucid, Inc." :changed "bytecode.c" "byte-opt.el" "byte-run.el"
"bytecomp.el" "delsel.el" "disass.el" "faces.el" "font-lock.el"
- "lmenu.el" "mailabbrev.el" "select.el" "xfaces.c" "xselect.c")
+ "mailabbrev.el" "select.el" "xfaces.c" "xselect.c")
;; MCC. No longer distributed: emacsserver.c.
("Microelectronics and Computer Technology Corporation"
:changed "etags.c" "emacsclient.c" "movemail.c"
@@ -773,7 +773,7 @@ Changes to files in this list are not listed.")
"erc-hecomplete.el"
"eshell/esh-maint.el"
"language/persian.el"
- "ledit.el" "meese.el" "iswitchb.el" "longlines.el"
+ "meese.el" "iswitchb.el" "longlines.el"
"mh-exec.el" "mh-init.el" "mh-customize.el"
"net/zone-mode.el" "xesam.el"
"term/mac-win.el" "sup-mouse.el"
diff --git a/admin/charsets/cp51932.awk b/admin/charsets/cp51932.awk
index 6aac988..c355509 100644
--- a/admin/charsets/cp51932.awk
+++ b/admin/charsets/cp51932.awk
@@ -43,13 +43,14 @@ BEGIN {
END {
print ")))";
- print " (mapc #'(lambda (x)";
- print " (setcar x (decode-char 'japanese-jisx0208 (car x))))";
- print " map)";
+ print " (setq map (mapcar (lambda (x)";
+ print " (cons (decode-char 'japanese-jisx0208 (car x))";
+ print " (cdr x)))";
+ print " map))";
print " (define-translation-table 'cp51932-decode map)";
- print " (mapc #'(lambda (x)";
- print " (let ((tmp (car x)))";
- print " (setcar x (cdr x)) (setcdr x tmp)))";
+ print " (mapc (lambda (x)";
+ print " (let ((tmp (car x)))";
+ print " (setcar x (cdr x)) (setcdr x tmp)))";
print " map)";
print " (define-translation-table 'cp51932-encode map))";
print "";
diff --git a/admin/charsets/eucjp-ms.awk b/admin/charsets/eucjp-ms.awk
index 0c9f94d..f6a6748 100644
--- a/admin/charsets/eucjp-ms.awk
+++ b/admin/charsets/eucjp-ms.awk
@@ -93,15 +93,17 @@ function write_entry (unicode) {
END {
print ")))";
- print " (mapc #'(lambda (x)";
+ print " (setq map";
+ print " (mapcar";
+ print " (lambda (x)";
print " (let ((code (logand (car x) #x7F7F)))";
print " (if (integerp (cdr x))";
- print " (setcar x (decode-char 'japanese-jisx0208 code))";
- print " (setcar x (decode-char 'japanese-jisx0212 code))";
- print " (setcdr x (cadr x)))))";
- print " map)";
+ print " (cons (decode-char 'japanese-jisx0208 code) (cdr x))";
+ print " (cons (decode-char 'japanese-jisx0212 code)"
+ print " (cadr x)))))";
+ print " map))";
print " (define-translation-table 'eucjp-ms-decode map)";
- print " (mapc #'(lambda (x)";
+ print " (mapc (lambda (x)";
print " (let ((tmp (car x)))";
print " (setcar x (cdr x)) (setcdr x tmp)))";
print " map)";
diff --git a/admin/notes/git-workflow b/admin/notes/git-workflow
index 28b6f91..d109cda 100644
--- a/admin/notes/git-workflow
+++ b/admin/notes/git-workflow
@@ -15,14 +15,15 @@ Initial setup
=============
Then we want to clone the repository. We normally want to have both
-the current master and the emacs-26 branch.
+the current master and (if there is one) the active release branch
+(eg emacs-27).
mkdir ~/emacs
cd ~/emacs
git clone <membername>@git.sv.gnu.org:/srv/git/emacs.git master
cd master
git config push.default current
-git worktree add ../emacs-26 emacs-26
+git worktree add ../emacs-27 emacs-27
You now have both branches conveniently accessible, and you can do
"git pull" in them once in a while to keep updated.
@@ -52,11 +53,11 @@ you commit your change locally and then send a patch file
as a bug report
as described in ../../CONTRIBUTE.
-Backporting to emacs-26
-=======================
+Backporting to release branch
+=============================
If you have applied a fix to the master, but then decide that it should
-be applied to the emacs-26 branch, too, then
+be applied to the release branch, too, then
cd ~/emacs/master
git log
@@ -66,7 +67,7 @@ which will look like
commit 958b768a6534ae6e77a8547a56fc31b46b63710b
-cd ~/emacs/emacs-26
+cd ~/emacs/emacs-27
git cherry-pick -xe 958b768a6534ae6e77a8547a56fc31b46b63710b
and add "Backport:" to the commit string. Then
@@ -74,17 +75,28 @@ and add "Backport:" to the commit string. Then
git push
-Merging emacs-26 to the master
-==============================
+Reverting on release branch
+===========================
+
+If a commit is made to the release branch, and then it is later
+decided that this change should only be on the master branch, the
+simplest way to handle this is to revert the commit on the release
+branch, and include in the associated log entry "do not merge to master".
+(Otherwise, the reversion may get merged to master, and inadvertently
+clobber the change on master if it has been manually made there.)
+
+
+Merging release branch to the master
+====================================
It is recommended to use the file gitmerge.el in the admin directory
-for merging 'emacs-26' into 'master'. It will take care of many
+for merging the release branch into 'master'. It will take care of many
things which would otherwise have to be done manually, like ignoring
commits that should not land in master, fixing up ChangeLogs and
automatically dealing with certain types of conflicts. If you really
want to, you can do the merge manually, but then you're on your own.
If you still choose to do that, make absolutely sure that you *always*
-use the 'merge' command to transport commits from 'emacs-26' to
+use the 'merge' command to transport commits from the release branch to
'master'. *Never* use 'cherry-pick'! If you don't know why, then you
shouldn't manually do the merge in the first place; just use
gitmerge.el instead.
@@ -97,11 +109,11 @@ up-to-date by doing a pull. Then start Emacs with
emacs -l admin/gitmerge.el -f gitmerge
You'll be asked for the branch to merge, which will default to
-'origin/emacs-26', which you should accept. Merging a local tracking
+(eg) 'origin/emacs-27', which you should accept. Merging a local tracking
branch is discouraged, since it might not be up-to-date, or worse,
contain commits from you which are not yet pushed upstream.
-You will now see the list of commits from 'emacs-26' which are not yet
+You will now see the list of commits from the release branch that are not yet
merged to 'master'. You might also see commits that are already
marked for "skipping", which means that they will be merged with a
different merge strategy ('ours'), which will effectively ignore the
diff --git a/build-aux/config.guess b/build-aux/config.guess
index 45001cf..11fda52 100755
--- a/build-aux/config.guess
+++ b/build-aux/config.guess
@@ -2,7 +2,7 @@
# Attempt to guess a canonical system name.
# Copyright 1992-2020 Free Software Foundation, Inc.
-timestamp='2020-01-01'
+timestamp='2020-04-26'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -1629,6 +1629,12 @@ copies of config.guess and config.sub with the latest
versions from:
https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess
and
https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub
+EOF
+
+year=`echo $timestamp | sed 's,-.*,,'`
+# shellcheck disable=SC2003
+if test "`expr "\`date +%Y\`" - "$year"`" -lt 3 ; then
+ cat >&2 <<EOF
If $0 has already been updated, send the following data and any
information you think might be pertinent to config-patches@gnu.org to
@@ -1656,6 +1662,7 @@ UNAME_RELEASE = "$UNAME_RELEASE"
UNAME_SYSTEM = "$UNAME_SYSTEM"
UNAME_VERSION = "$UNAME_VERSION"
EOF
+fi
exit 1
diff --git a/build-aux/config.sub b/build-aux/config.sub
index f02d43a..973a298 100755
--- a/build-aux/config.sub
+++ b/build-aux/config.sub
@@ -2,7 +2,7 @@
# Configuration validation subroutine script.
# Copyright 1992-2020 Free Software Foundation, Inc.
-timestamp='2020-01-01'
+timestamp='2020-05-04'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@@ -1366,7 +1366,7 @@ case $os in
| skyos* | haiku* | rdos* | toppers* | drops* | es* \
| onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \
| midnightbsd* | amdhsa* | unleashed* | emscripten* | wasi* \
- | nsk* | powerunix)
+ | nsk* | powerunix* | genode*)
# Remember, each alternative MUST END IN *, to match a version number.
;;
qnx*)
diff --git a/build-aux/gitlog-to-changelog b/build-aux/gitlog-to-changelog
index 5112767..be8082e 100755
--- a/build-aux/gitlog-to-changelog
+++ b/build-aux/gitlog-to-changelog
@@ -31,11 +31,11 @@
# are valid code in both sh and perl. When executed by sh, they re-execute
# the script through the perl program found in $PATH. The '-x' option
# is essential as well; without it, perl would re-execute the script
-# through /bin/sh. When executed by perl, the next two lines are a no-op.
+# through /bin/sh. When executed by perl, the next two lines are a no-op.
eval 'exec perl -wSx "$0" "$@"'
if 0;
-my $VERSION = '2018-03-07 03:47'; # UTC
+my $VERSION = '2020-04-04 15:07'; # UTC
# The definition above must lie within the first 8 lines in order
# for the Emacs time-stamp write hook (at end) to update it.
# If you change this file with Emacs, please let the write hook
diff --git a/build-aux/update-copyright b/build-aux/update-copyright
index 4f79b56..d9b7f68 100755
--- a/build-aux/update-copyright
+++ b/build-aux/update-copyright
@@ -133,11 +133,11 @@
# are valid code in both sh and perl. When executed by sh, they re-execute
# the script through the perl program found in $PATH. The '-x' option
# is essential as well; without it, perl would re-execute the script
-# through /bin/sh. When executed by perl, the next two lines are a no-op.
+# through /bin/sh. When executed by perl, the next two lines are a no-op.
eval 'exec perl -wSx -0777 -pi "$0" "$@"'
if 0;
-my $VERSION = '2018-03-07.03:47'; # UTC
+my $VERSION = '2020-04-04.15:07'; # UTC
# The definition above must lie within the first 8 lines in order
# for the Emacs time-stamp write hook (at end) to update it.
# If you change this file with Emacs, please let the write hook
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index 77a0e80..7074bd4 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -1541,6 +1541,11 @@ putting a line like this in your init file (@pxref{Init
File}):
(add-to-list 'load-path "/path/to/my/lisp/library")
@end example
+It is customary to put locally installed libraries in the
+@file{site-lisp} directory that is already in the default value of
+@code{load-path}, or in some subdirectory of @file{site-lisp}. This
+way, you don't need to modify the default value of @code{load-path}.
+
@cindex autoload
Some commands are @dfn{autoloaded}; when you run them, Emacs
automatically loads the associated library first. For instance, the
@@ -1563,6 +1568,33 @@ Automatic loading also occurs when completing names for
prefix being completed. To disable this feature, change the variable
@code{help-enable-completion-autoload} to @code{nil}.
+ Once you put your library in a directory where Emacs can find and
+load it, you may wish to make it available at startup. This is useful
+when the library defines features that should be available
+automatically on demand, and manually loading the library is thus
+inconvenient. In these cases, make sure the library will be loaded by
+adding suitable forms to your init file: either @code{load} or
+@code{require} (if you always need to load the library at startup), or
+@code{autoload} if you need Emacs to load the library when some
+command or function is invoked. For example:
+
+@smalllisp
+@group
+ ;; Loads @file{my-shining-package.elc} unconditionally.
+ (require 'my-shining-package)
+@end group
+@group
+ ;; Will load @file{my-shining-package.elc} when @code{my-func} is invoked.
+ (autoload 'my-func "my-shining-package")
+@end group
+@end smalllisp
+
+ Note that installing a package using @code{package-install}
+(@pxref{Package Installation}) takes care of placing the package's
+Lisp files in a directory where Emacs will find it, and also writes
+the necessary initialization code into your init files, making the
+above manual customizations unnecessary.
+
@node Lisp Eval
@section Evaluating Emacs Lisp Expressions
@cindex Emacs Lisp mode
diff --git a/doc/emacs/calendar.texi b/doc/emacs/calendar.texi
index 0911185..fe51ad3 100644
--- a/doc/emacs/calendar.texi
+++ b/doc/emacs/calendar.texi
@@ -532,8 +532,8 @@ holidays centered around a different month, use @kbd{C-u M-x
holidays}, which prompts for the month and year.
The holidays known to Emacs include United States holidays and the
-major Bahá'í, Chinese, Christian, Islamic, and Jewish holidays; also the
-solstices and equinoxes.
+major Bahá'í, Chinese, Christian, Islamic, and Jewish
+holidays; also the solstices and equinoxes.
@findex list-holidays
The command @kbd{M-x holiday-list} displays the list of holidays for
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index e7e8790..d034a78 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -755,7 +755,7 @@ non-@code{nil} value). If you set a variable using the
customization
buffer, you need not worry about giving it an invalid type: the
customization buffer usually only allows you to enter meaningful
values. When in doubt, use @kbd{C-h v} (@code{describe-variable}) to
-check the variable's documentation string to see kind of value it
+check the variable's documentation string to see what kind of value it
expects (@pxref{Examining}).
@menu
@@ -1882,7 +1882,7 @@ also unset keys, when passed @code{nil} as the binding.
Since a mode's keymaps are not constructed until it has been loaded,
you must delay running code which modifies them, e.g., by putting it
-on a @dfn{mode hook} (@pxref{(Hooks)}). For example, Texinfo mode
+on a @dfn{mode hook} (@pxref{Hooks}). For example, Texinfo mode
runs the hook @code{texinfo-mode-hook}. Here's how you can use the
hook to add local bindings for @kbd{C-c n} and @kbd{C-c p}, and remove
the one for @kbd{C-c C-x x} in Texinfo mode:
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index d514414..4ff1dc1 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -723,7 +723,13 @@ with renamed files so that they refer to the new names.
@vindex dired-vc-rename-file
If the value of the variable @code{dired-vc-rename-file} is non-@code{nil},
files are renamed using the commands of the underlying VCS, via
+@ifnottex
@code{vc-rename-file} (@pxref{VC Delete/Rename}).
+@end ifnottex
+@iftex
+@code{vc-rename-file} (@pxref{VC Delete/Rename,, Deleting and Renaming
+Version-Controlled Files, emacs-xtra, Specialized Emacs Features}).
+@end iftex
@findex dired-do-hardlink
@kindex H @r{(Dired)}
diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi
index d9373b8..8f448e1 100644
--- a/doc/emacs/frames.texi
+++ b/doc/emacs/frames.texi
@@ -1266,7 +1266,7 @@ Note that the Tab Bar is different from the Tab Line
(@pxref{Tab Line}).
Whereas tabs on the Tab Line at the top of each window are used to
switch between buffers, tabs on the Tab Bar at the top of each frame
are used to switch between window configurations containing several
-windows.
+windows with buffers.
@findex tab-bar-mode
To toggle the use of tab bars, type @kbd{M-x tab-bar-mode}. This
@@ -1324,6 +1324,10 @@ current before calling the command that adds a new tab.
To start a new tab with other buffers, customize the variable
@code{tab-bar-new-tab-choice}.
+@vindex tab-bar-new-tab-to
+ The variable @code{tab-bar-new-tab-to} defines where to place a new tab.
+By default, a new tab is added on the right side of the current tab.
+
The following commands can be used to delete tabs:
@table @kbd
@@ -1331,7 +1335,8 @@ To start a new tab with other buffers, customize the
variable
@kindex C-x t 0
@findex tab-close
Close the selected tab (@code{tab-close}). It has no effect if there
-is only one tab.
+is only one tab, unless the variable @code{tab-bar-close-last-tab-choice}
+is customized to a non-default value.
@item C-x t 1
@kindex C-x t 1
@@ -1339,6 +1344,14 @@ is only one tab.
Close all tabs on the selected frame, except the selected one.
@end table
+@vindex tab-bar-close-tab-select
+ The variable @code{tab-bar-close-tab-select} defines what tab to
+select after closing the current tab. By default, it selects
+a recently used tab.
+
+@findex tab-undo
+ The command @code{tab-undo} restores the last closed tab.
+
The following commands can be used to switch between tabs:
@table @kbd
@@ -1358,22 +1371,60 @@ switches back to the previous Nth tab.
Switch to the previous tab. With a positive numeric argument N, it
switches to the previous Nth tab; with a negative argument −N, it
switches back to the next Nth tab.
+
+@item C-x t @key{RET} @var{tabname} @key{RET}
+Switch to the tab by its name, with completion on all tab names.
+Default values are tab names sorted by recency, so you can use
+@kbd{M-n} (@code{next-history-element}) to get the name of the last
+visited tab, the second last, and so on.
+
+@item @var{modifier}-@var{tabnumber}
+@findex tab-select
+Switch to the tab by its number. After customizing the variable
+@code{tab-bar-select-tab-modifiers} to specify a @var{modifier} key, you
+can select a tab by its ordinal number using the specified modifier in
+combination with the tab number to select. To display the tab number
+alongside the tab name, you can customize another variable
+@code{tab-bar-tab-hints}. This will help you to decide what key to press
+to select the tab by its number.
+
+@item @var{modifier}-@kbd{0}
+@findex tab-recent
+Switch to the recent tab. The key combination is the modifier key
+defined by @code{tab-bar-select-tab-modifiers} and the key @kbd{0}.
+With a numeric argument N, switch to the Nth recent tab.
@end table
The following commands can be used to operate on tabs:
@table @kbd
@item C-x t r @var{tabname} @key{RET}
+@findex tab-rename
Rename the current tab to @var{tabname}. You can control the
programmatic name given to a tab by default by customizing the
variable @code{tab-bar-tab-name-function}.
@item C-x t m
+@findex tab-move
Move the current tab N positions to the right with a positive numeric
-argument N. With a negative argument −N, it moves the current tab
+argument N. With a negative argument −N, move the current tab
N positions to the left.
@end table
+@findex tab-bar-history-mode
+ You can enable @code{tab-bar-history-mode} to remember window
+configurations used in every tab, and restore them.
+
+@table @kbd
+@item tab-bar-history-back
+Restore a previous window configuration used in the current tab.
+This navigates back in the history of window configurations.
+
+@item tab-bar-history-forward
+Cancel restoration of the previous window configuration.
+This navigates forward in the history of window configurations.
+@end table
+
@node Dialog Boxes
@section Using Dialog Boxes
@cindex dialog boxes
diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi
index 49c53c5..167c32c 100644
--- a/doc/emacs/help.texi
+++ b/doc/emacs/help.texi
@@ -89,91 +89,97 @@ following sections.
@table @kbd
@item C-h a @var{topics} @key{RET}
Display a list of commands whose names match @var{topics}
-(@code{apropos-command}).
+(@code{apropos-command}). @xref{Apropos}.
@item C-h b
Display all active key bindings; minor mode bindings first, then those
of the major mode, then global bindings (@code{describe-bindings}).
+@xref{Misc Help}.
@item C-h c @var{key}
Show the name of the command that the key sequence @var{key} is bound
to (@code{describe-key-briefly}). Here @kbd{c} stands for
``character''. For more extensive information on @var{key}, use
-@kbd{C-h k}.
+@kbd{C-h k}. @xref{Key Help}.
@item C-h d @var{topics} @key{RET}
Display the commands and variables whose documentation matches
-@var{topics} (@code{apropos-documentation}).
+@var{topics} (@code{apropos-documentation}). @xref{Apropos}.
@item C-h e
Display the @file{*Messages*} buffer
-(@code{view-echo-area-messages}).
+(@code{view-echo-area-messages}). @xref{Misc Help}.
@item C-h f @var{function} @key{RET}
Display documentation on the Lisp function named @var{function}
(@code{describe-function}). Since commands are Lisp functions,
-this works for commands too.
+this works for commands too. @xref{Name Help}.
@item C-h h
Display the @file{HELLO} file, which shows examples of various character
sets.
@item C-h i
Run Info, the GNU documentation browser (@code{info}). The Emacs
-manual is available in Info.
+manual is available in Info. @xref{Misc Help}.
@item C-h k @var{key}
Display the name and documentation of the command that @var{key} runs
-(@code{describe-key}).
+(@code{describe-key}). @xref{Key Help}.
@item C-h l
Display a description of your last 300 keystrokes
-(@code{view-lossage}).
+(@code{view-lossage}). @xref{Misc Help}.
@item C-h m
Display documentation of the current major mode and minor modes
-(@code{describe-mode}).
+(@code{describe-mode}). @xref{Misc Help}.
@item C-h n
Display news of recent Emacs changes (@code{view-emacs-news}).
+@xref{Help Files}.
@item C-h o @var{symbol}
Display documentation of the Lisp symbol named @var{symbol}
(@code{describe-symbol}). This will show the documentation of all
-kinds of symbols: functions, variables, and faces.
+kinds of symbols: functions, variables, and faces. @xref{Name Help}.
@item C-h p
-Find packages by topic keyword (@code{finder-by-keyword}). This lists
-packages using a package menu buffer. @xref{Packages}.
+Find packages by topic keyword (@code{finder-by-keyword}).
+@xref{Package Keywords}. This lists packages using a package menu
+buffer. @xref{Packages}.
@item C-h P @var{package} @key{RET}
Display documentation about the specified package
-(@code{describe-package}).
+(@code{describe-package}). @xref{Package Keywords}.
@item C-h r
Display the Emacs manual in Info (@code{info-emacs-manual}).
@item C-h s
Display the contents of the current @dfn{syntax table}
-(@code{describe-syntax}). The syntax table says which characters are
-opening delimiters, which are parts of words, and so on. @xref{Syntax
-Tables,, Syntax Tables, elisp, The Emacs Lisp Reference Manual}, for
-details.
+(@code{describe-syntax}). @xref{Misc Help}. The syntax table says
+which characters are opening delimiters, which are parts of words, and
+so on. @xref{Syntax Tables,, Syntax Tables, elisp, The Emacs Lisp
+Reference Manual}, for details.
@item C-h t
Enter the Emacs interactive tutorial (@code{help-with-tutorial}).
@item C-h v @var{var} @key{RET}
Display the documentation of the Lisp variable @var{var}
-(@code{describe-variable}).
+(@code{describe-variable}). @xref{Name Help}.
@item C-h w @var{command} @key{RET}
Show which keys run the command named @var{command} (@code{where-is}).
+@xref{Key Help}.
@item C-h C @var{coding} @key{RET}
Describe the coding system @var{coding}
-(@code{describe-coding-system}).
+(@code{describe-coding-system}). @xref{Coding Systems}.
@item C-h C @key{RET}
Describe the coding systems currently in use.
@item C-h F @var{command} @key{RET}
Enter Info and go to the node that documents the Emacs command
-@var{command} (@code{Info-goto-emacs-command-node}).
+@var{command} (@code{Info-goto-emacs-command-node}). @xref{Name Help}.
@item C-h I @var{method} @key{RET}
Describe the input method @var{method} (@code{describe-input-method}).
+@xref{Select Input Method}.
@item C-h K @var{key}
Enter Info and go to the node that documents the key sequence
-@var{key} (@code{Info-goto-emacs-key-command-node}).
+@var{key} (@code{Info-goto-emacs-key-command-node}). @xref{Key Help}.
@item C-h L @var{language-env} @key{RET}
Display information on the character sets, coding systems, and input
methods used in language environment @var{language-env}
-(@code{describe-language-environment}).
+(@code{describe-language-environment}). @xref{Language Environments}.
@item C-h S @var{symbol} @key{RET}
Display the Info documentation on symbol @var{symbol} according to the
programming language you are editing (@code{info-lookup-symbol}).
+@xref{Misc Help}.
@item C-h .
Display the help message for a special text area, if point is in one
(@code{display-local-help}). (These include, for example, links in
-@file{*Help*} buffers.)
+@file{*Help*} buffers.) @xref{Help Echo}.
@end table
@node Key Help
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index 834a5c6..6b1f35e 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -727,6 +727,8 @@ them. Rectangle commands are useful with text in
multicolumn formats,
and for changing text into or out of such formats.
@cindex mark rectangle
+@cindex region-rectangle
+@cindex rectangular region
To specify a rectangle for a command to work on, set the mark at one
corner and point at the opposite corner. The rectangle thus specified
is called the @dfn{region-rectangle}. If point and the mark are in
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 47f195d..1336da1 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -2920,9 +2920,17 @@ you might like to bind to keys, such as
@code{browse-url-at-point} and
You can customize Browse-URL's behavior via various options in the
@code{browse-url} Customize group. In particular, the option
@code{browse-url-mailto-function} lets you define how to follow
-@samp{mailto:} URLs, while @code{browse-url-browser-function} lets you
-define how to follow other types of URLs. For more information, view
-the package commentary by typing @kbd{C-h P browse-url @key{RET}}.
+@samp{mailto:} URLs, while @code{browse-url-browser-function}
+specifies your default browser.
+
+@vindex browse-url-handlers
+ You can define that certain URLs are browsed with other functions by
+customizing @code{browse-url-handlers}, an alist of regular
+expressions or predicates paired with functions to browse matching
+URLs.
+
+For more information, view the package commentary by typing @kbd{C-h P
+browse-url @key{RET}}.
@node Goto Address mode
@subsection Activating URLs
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index f5fb6b1..c1420ea 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -116,7 +116,7 @@ is enabled in a buffer. @xref{Hooks}, for more information
about
hooks. Each mode hook is named after its major mode, e.g., Fortran
mode has @code{fortran-mode-hook}. Furthermore, all text-based major
modes run @code{text-mode-hook}, and many programming language modes
-@footnote{More specifically, the modes which are ''derived'' from
+@footnote{More specifically, the modes which are ``derived'' from
@code{prog-mode} (@pxref{Derived Modes,,, elisp, The Emacs Lisp
Reference Manual}).} (including all those distributed with Emacs) run
@code{prog-mode-hook}, prior to running their own mode hooks. Hook
diff --git a/doc/emacs/mule.texi b/doc/emacs/mule.texi
index e3fe20c..373c7b5 100644
--- a/doc/emacs/mule.texi
+++ b/doc/emacs/mule.texi
@@ -1326,16 +1326,17 @@ stored in the system and the available font names are
defined by the
system, fontsets are defined within Emacs itself. Once you have
defined a fontset, you can use it within Emacs by specifying its name,
anywhere that you could use a single font. Of course, Emacs fontsets
-can use only the fonts that the system supports. If some characters
+can use only the fonts that your system supports. If some characters
appear on the screen as empty boxes or hex codes, this means that the
fontset in use for them has no font for those characters. In this
case, or if the characters are shown, but not as well as you would
-like, you may need to install extra fonts. Your operating system may
-have optional fonts that you can install; or you can install the GNU
-Intlfonts package, which includes fonts for most supported
-scripts.@footnote{If you run Emacs on X, you may need to inform the X
-server about the location of the newly installed fonts with commands
-such as:
+like, you may need to install extra fonts or modify the fontset to use
+specific fonts already installed on your system (see below). Your
+operating system may have optional fonts that you can install; or you
+can install the GNU Intlfonts package, which includes fonts for most
+supported scripts.@footnote{If you run Emacs on X, you may need to
+inform the X server about the location of the newly installed fonts
+with commands such as:
@c FIXME? I feel like this may be out of date.
@c E.g., the intlfonts tarfile is ~ 10 years old.
@@ -1376,14 +1377,20 @@ explicitly requested, despite its name.
@w{@kbd{M-x describe-fontset}} command. It prompts for a fontset
name, defaulting to the one used by the current frame, and then
displays all the subranges of characters and the fonts assigned to
-them in that fontset.
+them in that fontset. To see which fonts Emacs is using in a session
+started without a specific fontset (which is what happens normally),
+type @kbd{fontset-default @key{RET}} at the prompt, or just
+@kbd{@key{RET}} to describe the fontset used by the current frame.
A fontset does not necessarily specify a font for every character
code. If a fontset specifies no font for a certain character, or if
it specifies a font that does not exist on your system, then it cannot
display that character properly. It will display that character as a
-hex code or thin space or an empty box instead. (@xref{Text Display, ,
-glyphless characters}, for details.)
+hex code or thin space or an empty box instead. (@xref{Text Display,
+, glyphless characters}, for details.) Or a fontset might specify a
+font for some range of characters, but you may not like their visual
+appearance. If this happens, you may wish to modify your fontset; see
+@ref{Modifying Fontsets}, for how to do that.
@node Defining Fontsets
@section Defining Fontsets
@@ -1542,10 +1549,10 @@ call this function explicitly to create a fontset.
Fontsets do not always have to be created from scratch. If only
minor changes are required it may be easier to modify an existing
-fontset. Modifying @samp{fontset-default} will also affect other
-fontsets that use it as a fallback, so can be an effective way of
-fixing problems with the fonts that Emacs chooses for a particular
-script.
+fontset, usually @samp{fontset-default}. Modifying
+@samp{fontset-default} will also affect other fontsets that use it as
+a fallback, so can be an effective way of fixing problems with the
+fonts that Emacs chooses for a particular script.
Fontsets can be modified using the function @code{set-fontset-font},
specifying a character, a charset, a script, or a range of characters
@@ -1553,26 +1560,61 @@ to modify the font for, and a font specification for
the font to be
used. Some examples are:
@example
-;; Use Liberation Mono for latin-3 charset.
-(set-fontset-font "fontset-default" 'iso-8859-3
- "Liberation Mono")
-
;; Prefer a big5 font for han characters.
(set-fontset-font "fontset-default"
'han (font-spec :registry "big5")
nil 'prepend)
+;; Use MyPrivateFont for the Unicode private use area.
+(set-fontset-font "fontset-default" '(#xe000 . #xf8ff)
+ "MyPrivateFont")
+
+;; Use Liberation Mono for latin-3 charset.
+(set-fontset-font "fontset-default" 'iso-8859-3
+ "Liberation Mono")
+
;; Use DejaVu Sans Mono as a fallback in fontset-startup
;; before resorting to fontset-default.
(set-fontset-font "fontset-startup" nil "DejaVu Sans Mono"
nil 'append)
+@end example
-;; Use MyPrivateFont for the Unicode private use area.
-(set-fontset-font "fontset-default" '(#xe000 . #xf8ff)
- "MyPrivateFont")
+@noindent
+@xref{Fontsets, , , elisp, GNU Emacs Lisp Reference Manual}, for more
+details about using the @code{set-fontset-font} function.
+
+@cindex script of a character
+@cindex codepoint of a character
+If you don't know the character's codepoint or the script to which it
+belongs, you can ask Emacs. With point at the character, type
+@w{@kbd{C-u C-x =}} (@code{what-cursor-position}), and this
+information, together with much more, will be displayed in the
+@file{*Help*} buffer that Emacs pops up. @xref{Position Info}. For
+example, Japanese characters belong to the @samp{kana} script, but
+Japanese text also mixes them with Chinese characters so the following
+uses the @samp{han} script to set up Emacs to use the @samp{Kochi
+Gothic} font for Japanese text:
+@example
+(set-fontset-font "fontset-default" 'han "Kochi Gothic")
@end example
+@noindent
+@cindex CKJ characters
+(For convenience, the @samp{han} script in Emacs is set up to support
+all of the Chinese, Japanese, and Korean, a.k.a.@: @acronym{CJK},
+characters, not just Chinese characters.)
+
+@vindex script-representative-chars
+For the list of known scripts, see the variable
+@code{script-representative-chars}.
+
+Fontset settings like those above only affect characters that the
+default font doesn't support, so if the @samp{Kochi Gothic} font
+covers Latin characters, it will not be used for displaying Latin
+scripts, since the default font used by Emacs usually covers Basic
+Latin.
+
@cindex ignore font
@cindex fonts, how to ignore
@vindex face-ignored-fonts
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index db3cf31..453d9eb 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -5,23 +5,37 @@
@node Packages
@chapter Emacs Lisp Packages
@cindex Package
-@cindex Emacs Lisp package archive
@cindex Package archive
-Emacs includes a facility that lets you easily download and install
-@dfn{packages} that implement additional features. Each package is a
-separate Emacs Lisp program, sometimes including other components such
-as an Info manual.
+ Emacs is extended by implementing additional features in
+@dfn{packages}, which are Emacs Lisp libraries. These could be
+written by you or provided by someone else. If you want to install
+such a package so it is available in your future Emacs session, you
+need to compile it and put it in a directory where Emacs looks for
+Lisp libraries. @xref{Lisp Libraries}, for more details about this
+manual installation method. Many packages provide installation and
+usage instructions in the large commentary near the beginning of the
+Lisp file; you can use those instructions for installing and
+fine-tuning your use of the package.
- @kbd{M-x list-packages} brings up a buffer named @file{*Packages*}
-with a list of all packages. You can install or uninstall packages
-via this buffer. @xref{Package Menu}.
+@cindex Emacs Lisp package archive
+ Packages can also be provided by @dfn{package archives}, which are
+large collections of Emacs Lisp packages. Each package is a separate
+Emacs Lisp program, sometimes including other components such as an
+Info manual. Emacs includes a facility that lets you easily download
+and install packages from such archives. The rest of this chapter
+describes this facility.
+
+ To list the packages available for installation from package
+archives, type @w{@kbd{M-x list-packages @key{RET}}}. It brings up a
+buffer named @file{*Packages*} with a list of all packages. You can
+install or uninstall packages via this buffer. @xref{Package Menu}.
The command @kbd{C-h P} (@code{describe-package}) prompts for the
name of a package, and displays a help buffer describing the
attributes of the package and the features that it implements.
- By default, Emacs downloads packages from a @dfn{package archive}
+ By default, Emacs downloads packages from a package archive
maintained by the Emacs developers and hosted by the GNU project.
Optionally, you can also download packages from archives maintained by
third parties. @xref{Package Installation}.
@@ -202,6 +216,12 @@ This prompts first for one of the qualifiers @samp{<},
@samp{>} or
@samp{=}, and then a package version, and shows packages that has a
lower, equal or higher version than the one specified.
+@item / m
+@kindex / m @r{(Package Menu)}
+@findex package-menu-filter-marked
+Filter package list by non-empty mark (@code{package-menu-filter-marked}).
+This shows only the packages that have been marked to be installed or deleted.
+
@item / /
@kindex / / @r{(Package Menu)}
@findex package-menu-filter-clear
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index 1691661..2e094f3 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1324,10 +1324,14 @@ case-sensitive. Thus, searching for @samp{Foo} does
not find
@samp{foo} or @samp{FOO}. This applies to regular expression search
as well as to literal string search. The effect ceases if you delete
the upper-case letter from the search string. The variable
-@code{search-upper-case} controls this: if it is non-@code{nil} (the
-default), an upper-case character in the search string makes the
-search case-sensitive; setting it to @code{nil} disables this effect
-of upper-case characters.
+@code{search-upper-case} controls this: if it is non-@code{nil}, an
+upper-case character in the search string makes the search
+case-sensitive; setting it to @code{nil} disables this effect of
+upper-case characters. The default value of this variable is
+@code{not-yanks}, which makes search case-sensitive if there are
+upper-case letters in the search string, and also causes text yanked
+into the search string (@pxref{Isearch Yank}) to be down-cased, so
+that such searches are case-insensitive by default.
@vindex case-fold-search
If you set the variable @code{case-fold-search} to @code{nil}, then
@@ -1572,9 +1576,13 @@ searching for patterns.
@cindex case folding in replace commands
If the first argument of a replace command is all lower case, the
command ignores case while searching for occurrences to
-replace---provided @code{case-fold-search} is non-@code{nil}. If
-@code{case-fold-search} is set to @code{nil}, case is always significant
-in all searches.
+replace---provided @code{case-fold-search} is non-@code{nil} and
+@code{search-upper-case} is also non-@code{nil}. If
+@code{search-upper-case} (@pxref{Lax Search, search-upper-case}) is
+@code{nil}, whether searching ignores case is determined by
+@code{case-fold-search} alone, regardless of letter-case of the
+command's first argument. If @code{case-fold-search} is set to
+@code{nil}, case is always significant in all searches.
@vindex case-replace
In addition, when the @var{newstring} argument is all or partly lower
diff --git a/doc/emacs/windows.texi b/doc/emacs/windows.texi
index cb5e9bc..4c67660 100644
--- a/doc/emacs/windows.texi
+++ b/doc/emacs/windows.texi
@@ -628,8 +628,16 @@ Selecting the previous window-local tab is the same as
typing @kbd{C-x
same as @kbd{C-x @key{RIGHT}} (@code{next-buffer}). Both commands
support a numeric prefix argument as a repeat count.
+You can customize the variable @code{tab-line-tabs-function} to define
+the preferred contents of the tab line. By default, it displays all
+buffers previously visited in the window, as described above. But you
+can also set it to display a list of buffers with the same major mode
+as the current buffer, or to display buffers grouped by their major
+mode, where clicking on the mode name in the first tab displays a list
+of all major modes where you can select another group of buffers.
+
Note that the Tab Line is different from the Tab Bar (@pxref{Tab Bars}).
Whereas tabs on the Tab Bar at the top of each frame are used to
-switch between window configurations containing several windows,
+switch between window configurations containing several windows with buffers,
tabs on the Tab Line at the top of each window are used to switch
-between buffers.
+between buffers in the window.
diff --git a/doc/lispintro/emacs-lisp-intro.texi
b/doc/lispintro/emacs-lisp-intro.texi
index 7484ce5..f6dd77a 100644
--- a/doc/lispintro/emacs-lisp-intro.texi
+++ b/doc/lispintro/emacs-lisp-intro.texi
@@ -7317,8 +7317,6 @@ which leave the original list as it was. One way to find
out how this
works is to experiment. We will start with the @code{setcar} function.
@need 1200
-@cindex constant lists
-@cindex mutable lists
First, we can make a list and then set the value of a variable to the
list, using the @code{setq} special form. Because we intend to use
@code{setcar} to change the list, this @code{setq} should not use the
@@ -7327,8 +7325,7 @@ a list that is part of the program and bad things could
happen if we
tried to change part of the program while running it. Generally
speaking an Emacs Lisp program's components should be constant (or
unchanged) while the program is running. So we instead construct an
-animal list that is @dfn{mutable} (or changeable) by using the
-@code{list} function, as follows:
+animal list by using the @code{list} function, as follows:
@smallexample
(setq animals (list 'antelope 'giraffe 'lion 'tiger))
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index c601e3a..58f9336 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1905,6 +1905,7 @@ variables precisely as they were at the time of the error.
@subsubsection Writing Code to Handle Errors
@cindex error handler
@cindex handling errors
+@cindex handle Lisp errors
@cindex forms for handling errors
The usual effect of signaling an error is to terminate the command
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index e53f0e9..3d738b9 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -3597,9 +3597,9 @@ characters in the range @var{from} and @var{to}
(inclusive).
@var{character} may be a charset (@pxref{Character Sets}). In that
case, use @var{font-spec} for all the characters in the charset.
-@var{character} may be a script name (@pxref{Character Properties}).
-In that case, use @var{font-spec} for all the characters belonging to
-the script.
+@var{character} may be a script name (@pxref{Character Properties,
+char-script-table}). In that case, use @var{font-spec} for all the
+characters belonging to the script.
@var{character} may be @code{nil}, which means to use @var{font-spec}
for any character which no font-spec is specified.
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index bba1b63..9a67967 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -297,7 +297,7 @@ Lisp Data Types
* Circular Objects:: Read syntax for circular structure.
* Type Predicates:: Tests related to types.
* Equality Predicates:: Tests of equality between any two objects.
-* Constants and Mutability:: Whether an object's value can change.
+* Mutability:: Some objects should not be modified.
Programming Types
diff --git a/doc/lispref/eval.texi b/doc/lispref/eval.texi
index baddce4..39f342a 100644
--- a/doc/lispref/eval.texi
+++ b/doc/lispref/eval.texi
@@ -158,11 +158,11 @@ contents unchanged.
@end group
@end example
- A self-evaluating form yields constant conses, vectors and strings, and you
-should not attempt to modify their contents via @code{setcar}, @code{aset} or
+ A self-evaluating form yields a value that becomes part of the program,
+and you should not try to modify it via @code{setcar}, @code{aset} or
similar operations. The Lisp interpreter might unify the constants
yielded by your program's self-evaluating forms, so that these
-constants might share structure. @xref{Constants and Mutability}.
+constants might share structure. @xref{Mutability}.
It is common to write numbers, characters, strings, and even vectors
in Lisp code, taking advantage of the fact that they self-evaluate.
@@ -564,8 +564,8 @@ and vectors.)
@defspec quote object
This special form returns @var{object}, without evaluating it.
-The returned value is a constant, and should not be modified.
-@xref{Constants and Mutability}.
+The returned value might be shared and should not be modified.
+@xref{Self-Evaluating Forms}.
@end defspec
@cindex @samp{'} for quoting
@@ -608,9 +608,9 @@ Here are some examples of expressions that use @code{quote}:
Although the expressions @code{(list '+ 1 2)} and @code{'(+ 1 2)}
both yield lists equal to @code{(+ 1 2)}, the former yields a
-freshly-minted mutable list whereas the latter yields a constant list
-built from conses that may be shared with other constants.
-@xref{Constants and Mutability}.
+freshly-minted mutable list whereas the latter yields a list
+built from conses that might be shared and should not be modified.
+@xref{Self-Evaluating Forms}.
Other quoting constructs include @code{function} (@pxref{Anonymous
Functions}), which causes an anonymous lambda expression written in Lisp
@@ -710,8 +710,9 @@ Here are some examples:
@end example
If a subexpression of a backquote construct has no substitutions or
-splices, it acts like @code{quote} in that it yields constant conses,
-vectors and strings that should not be modified.
+splices, it acts like @code{quote} in that it yields conses,
+vectors and strings that might be shared and should not be modified.
+@xref{Self-Evaluating Forms}.
@node Eval
@section Eval
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index b3ad9b9..686dbdb 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1909,6 +1909,11 @@ omitted or @code{nil}, it defaults to 0, i.e., no access
rights at
all.
@end defun
+@defun file-modes-number-to-symbolic modes
+This function converts a numeric file mode specification in
+@var{modes} into the equivalent symbolic form.
+@end defun
+
@defun set-file-times filename &optional time flag
This function sets the access and modification times of @var{filename}
to @var{time}. The return value is @code{t} if the times are successfully
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 905e5c2..6bf5db2 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -3875,13 +3875,15 @@ detailed knowledge of what types other applications use
for drag and
drop.
@vindex dnd-protocol-alist
+@vindex browse-url-handlers
+@vindex browse-url-default-handlers
When an URL is dropped on Emacs it may be a file, but it may also be
another URL type (https, etc.). Emacs first checks
@code{dnd-protocol-alist} to determine what to do with the URL@. If
-there is no match there and if @code{browse-url-browser-function} is
-an alist, Emacs looks for a match there. If no match is found the
-text for the URL is inserted. If you want to alter Emacs behavior,
-you can customize these variables.
+there is no match there, Emacs looks for a match in
+@code{browse-url-handlers} and @code{browse-url-default-handlers}. If
+still no match has been found, the text for the URL is inserted. If
+you want to alter Emacs behavior, you can customize these variables.
@node Color Names
@section Color Names
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index ea44e01..ae793d5 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -873,8 +873,8 @@ primitives @code{setcar} and @code{setcdr}. These are
destructive
operations because they change existing list structure.
Destructive operations should be applied only to mutable lists,
that is, lists constructed via @code{cons}, @code{list} or similar
-operations. Lists created by quoting are constants and should not be
-changed by destructive operations. @xref{Constants and Mutability}.
+operations. Lists created by quoting are part of the program and
+should not be changed by destructive operations. @xref{Mutability}.
@cindex CL note---@code{rplaca} vs @code{setcar}
@quotation
@@ -911,7 +911,7 @@ value @var{object}. For example:
@example
@group
-(setq x (list 1 2)) ; @r{Create a mutable list.}
+(setq x (list 1 2))
@result{} (1 2)
@end group
@group
@@ -931,7 +931,7 @@ these lists. Here is an example:
@example
@group
-;; @r{Create two mutable lists that are partly shared.}
+;; @r{Create two lists that are partly shared.}
(setq x1 (list 'a 'b 'c))
@result{} (a b c)
(setq x2 (cons 'z (cdr x1)))
@@ -1022,11 +1022,11 @@ reached via the @sc{cdr}.
@example
@group
-(setq x (list 1 2 3)) ; @r{Create a mutable list.}
+(setq x (list 1 2 3))
@result{} (1 2 3)
@end group
@group
-(setcdr x '(4)) ; @r{Modify the list's tail to be a constant list.}
+(setcdr x '(4))
@result{} (4)
@end group
@group
@@ -1135,11 +1135,11 @@ Unlike @code{append} (@pxref{Building Lists}), the
@var{lists} are
@example
@group
-(setq x (list 1 2 3)) ; @r{Create a mutable list.}
+(setq x (list 1 2 3))
@result{} (1 2 3)
@end group
@group
-(nconc x '(4 5)) ; @r{Modify the list's tail to be a constant list.}
+(nconc x '(4 5))
@result{} (1 2 3 4 5)
@end group
@group
@@ -1242,8 +1242,8 @@ compare @var{object} against the elements of the list.
For example:
@result{} (b c b a)
@end group
@group
-(memq '(2) '((1) (2))) ; @r{@code{(2)} and @code{(2)} are not @code{eq}.}
- @result{} nil
+(memq '(2) '((1) (2))) ; @r{The two @code{(2)}s need not be @code{eq}.}
+ @result{} @r{Unspecified; might be @code{nil} or @code{((2))}.}
@end group
@end example
@end defun
@@ -1356,12 +1356,12 @@ Compare this with @code{memq}:
@example
@group
-(memql 1.2 '(1.1 1.2 1.3)) ; @r{@code{1.2} and @code{1.2} must be @code{eql}.}
+(memql 1.2 '(1.1 1.2 1.3)) ; @r{@code{1.2} and @code{1.2} are @code{eql}.}
@result{} (1.2 1.3)
@end group
@group
-(memq 1.2 '(1.1 1.2 1.3)) ; @r{@code{1.2} and @code{1.2} need not be
@code{eq}.}
- @result{} nil ; @r{... or it might be @code{(1.2 1.3)}.}
+(memq 1.2 '(1.1 1.2 1.3)) ; @r{The two @code{1.2}s need not be @code{eq}.}
+ @result{} @r{Unspecified; might be @code{nil} or @code{(1.2 1.3)}.}
@end group
@end example
@end defun
@@ -1380,12 +1380,12 @@ Compare this with @code{memq}:
@example
@group
-(member (list 2) '((1) (2))) ; @r{@code{(list 2)} and @code{(2)} are
@code{equal}.}
+(member '(2) '((1) (2))) ; @r{@code{(2)} and @code{(2)} are @code{equal}.}
@result{} ((2))
@end group
@group
-(memq (list 2) '((1) (2))) ; @r{@code{(list 2)} and @code{(2)} are not
@code{eq}.}
- @result{} nil
+(memq '(2) '((1) (2))) ; @r{The two @code{(2)}s need not be @code{eq}.}
+ @result{} @r{Unspecified; might be @code{nil} or @code{(2)}.}
@end group
@group
;; @r{Two strings with the same contents are @code{equal}.}
@@ -1626,7 +1626,7 @@ keys may not be symbols:
("compound leaves" . horsechestnut)))
(assq "simple leaves" leaves)
- @result{} @r{Unspecified; might be @code{nil} or non-@code{nil}.}
+ @result{} @r{Unspecified; might be @code{nil} or @code{("simple leaves" .
oak)}.}
(assoc "simple leaves" leaves)
@result{} ("simple leaves" . oak)
@end smallexample
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index fc68ee1..eaee56f 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -1352,19 +1352,11 @@ illustrate how these modes are written.
@end smallexample
The three modes for Lisp share much of their code. For instance,
-each calls the following function to set various variables:
-
-@smallexample
-@group
-(defun lisp-mode-variables (&optional syntax keywords-case-insensitive elisp)
- (when syntax
- (set-syntax-table lisp-mode-syntax-table))
- @dots{}
-@end group
-@end smallexample
+Lisp mode and Emacs Lisp mode inherit from Lisp Data mode and Lisp
+Interaction Mode inherits from Emacs Lisp mode.
@noindent
-Amongst other things, this function sets up the @code{comment-start}
+Amongst other things, Lisp Data mode sets up the @code{comment-start}
variable to handle Lisp comments:
@smallexample
@@ -1414,7 +1406,7 @@ Finally, here is the major mode command for Lisp mode:
@smallexample
@group
-(define-derived-mode lisp-mode prog-mode "Lisp"
+(define-derived-mode lisp-mode lisp-data-mode "Lisp"
"Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
Commands:
Delete converts tabs to spaces as it moves back.
@@ -1425,7 +1417,6 @@ Note that `run-lisp' may be used either to start an
inferior Lisp job
or to switch back to an existing one."
@end group
@group
- (lisp-mode-variables nil t)
(setq-local find-tag-default-function 'lisp-find-tag-default)
(setq-local comment-start-skip
"\\(\\(^\\|[^\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index d35a9ac..8306674 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -46,10 +46,6 @@ you store in it, type and all. (Actually, a small number of
Emacs
Lisp variables can only take on values of a certain type.
@xref{Variables with Restricted Values}.)
- Some Lisp objects are @dfn{constant}: their values should never change.
-Others are @dfn{mutable}: their values can be changed via destructive
-operations that involve side effects.
-
This chapter describes the purpose, printed representation, and read
syntax of each of the standard types in GNU Emacs Lisp. Details on how
to use these types can be found in later chapters.
@@ -63,7 +59,7 @@ to use these types can be found in later chapters.
* Circular Objects:: Read syntax for circular structure.
* Type Predicates:: Tests related to types.
* Equality Predicates:: Tests of equality between any two objects.
-* Constants and Mutability:: Whether an object's value can change.
+* Mutability:: Some objects should not be modified.
@end menu
@node Printed Representation
@@ -2383,52 +2379,58 @@ that for two strings to be equal, they have the same
text properties.
@end example
@end defun
-@node Constants and Mutability
-@section Constants and Mutability
-@cindex constants
+@node Mutability
+@section Mutability
@cindex mutable objects
- Some Lisp objects are constant: their values should never change
-during a single execution of Emacs running well-behaved Lisp code.
-For example, you can create a new integer by calculating one, but you
-cannot modify the value of an existing integer.
-
- Other Lisp objects are mutable: it is safe to change their values
-via destructive operations involving side effects. For example, an
-existing marker can be changed by moving the marker to point to
-somewhere else.
-
- Although all numbers are constants and all markers are
-mutable, some types contain both constant and mutable members. These
-types include conses, vectors, strings, and symbols. For example, the string
-literal @code{"aaa"} yields a constant string, whereas the function
-call @code{(make-string 3 ?a)} yields a mutable string that can be
+ Some Lisp objects should never change. For example, the Lisp
+expression @code{"aaa"} yields a string, but you should not change
+its contents. And some objects cannot be changed; for example,
+although you can create a new number by calculating one, Lisp provides
+no operation to change the value of an existing number.
+
+ Other Lisp objects are @dfn{mutable}: it is safe to change their
+values via destructive operations involving side effects. For
+example, an existing marker can be changed by moving the marker to
+point to somewhere else.
+
+ Although numbers never change and all markers are mutable,
+some types have members some of which are mutable and others not. These
+types include conses, vectors, and strings. For example,
+although @code{"cons"} and @code{(symbol-name 'cons)} both yield
+strings that should not be changed, @code{(copy-sequence "cons")} and
+@code{(make-string 3 ?a)} both yield mutable strings that can be
changed via later calls to @code{aset}.
- A mutable object can become constant if it is part of an expression
-that is evaluated, because a program should not modify an object
-that is being evaluated. The reverse does not occur: constant objects
-should stay constant.
-
- Trying to modify a constant variable signals an error
-(@pxref{Constant Variables}).
-A program should not attempt to modify other types of constants because the
-resulting behavior is undefined: the Lisp interpreter might or might
-not detect the error, and if it does not detect the error the
-interpreter can behave unpredictably thereafter. Another way to put
-this is that although mutable objects are safe to change and constant
-variables reliably prevent attempts to change them, other constants
-are not safely mutable: if a misbehaving program tries to change such a
-constant then the constant's value might actually change, or the
-program might crash or worse. This problem occurs
-with types that have both constant and mutable members, and that have
-mutators like @code{setcar} and @code{aset} that are valid on mutable
-objects but hazardous on constants.
-
- When the same constant occurs multiple times in a program, the Lisp
+ A mutable object stops being mutable if it is part of an expression
+that is evaluated. For example:
+
+@example
+(let* ((x (list 0.5))
+ (y (eval (list 'quote x))))
+ (setcar x 1.5) ;; The program should not do this.
+ y)
+@end example
+
+@noindent
+Although the list @code{(0.5)} was mutable when it was created, it should not
+have been changed via @code{setcar} because it given to @code{eval}. The
+reverse does not occur: an object that should not be changed never
+becomes mutable afterwards.
+
+ If a program attempts to change objects that should not be
+changed, the resulting behavior is undefined: the Lisp interpreter
+might signal an error, or it might crash or behave unpredictably in
+other ways.@footnote{This is the behavior specified for languages like
+Common Lisp and C for constants, and this differs from languages like
+JavaScript and Python where an interpreter is required to signal an
+error if a program attempts to change an immutable object. Ideally the Emacs
+Lisp interpreter will evolve in latter direction.}
+
+ When similar constants occur as parts of a program, the Lisp
interpreter might save time or space by reusing existing constants or
-constant components. For example, @code{(eq "abc" "abc")} returns
+their components. For example, @code{(eq "abc" "abc")} returns
@code{t} if the interpreter creates only one instance of the string
-constant @code{"abc"}, and returns @code{nil} if it creates two
+literal @code{"abc"}, and returns @code{nil} if it creates two
instances. Lisp programs should be written so that they work
regardless of whether this optimization is in use.
diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi
index 5c0b1e2..8f2c743 100644
--- a/doc/lispref/os.texi
+++ b/doc/lispref/os.texi
@@ -613,7 +613,7 @@ The elements of the @code{command-switch-alist} look like
this:
@end example
The @sc{car}, @var{option}, is a string, the name of a command-line
-option (not including the initial hyphen). The @var{handler-function}
+option (including the initial hyphen). The @var{handler-function}
is called to handle @var{option}, and receives the option name as its
sole argument.
@@ -623,6 +623,14 @@ remaining command-line arguments in the variable
@code{command-line-args-left} (see below). (The entire list of
command-line arguments is in @code{command-line-args}.)
+Note that the handling of @code{command-switch-alist} doesn't treat
+equals signs in @var{option} specially. That is, if there's an option
+like @code{--name=value} on the command line, then only a
+@code{command-switch-alist} member whose @code{car} is literally
+@code{--name=value} will match this option. If you want to parse such
+options, you need to use @code{command-line-functions} instead (see
+below).
+
The command-line arguments are parsed by the @code{command-line-1}
function in the @file{startup.el} file. See also @ref{Emacs
Invocation, , Command Line Arguments for Emacs Invocation, emacs, The
@@ -2182,9 +2190,9 @@ cause anything special to happen.
@findex list-timers
The @code{list-timers} command lists all the currently active timers.
-There's only one command available in the buffer displayed: @kbd{c}
-(@code{timer-list-cancel}) that will cancel the timer on the line
-under point.
+The command @kbd{c} (@code{timer-list-cancel}) will cancel the timer
+on the line under point. You can sort the list by column using the
+command @kbd{S} (@code{tabulated-list-sort}).
@node Idle Timers
@section Idle Timers
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index c6e735a..22c5093 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -477,6 +477,22 @@ You should only ever change this variable with a
let-binding; never
with @code{setq}.
@end defvar
+@defopt process-file-return-signal-string
+This user option indicates whether a call of @code{process-file}
+returns a string describing the signal interrupting a remote process.
+
+When a process returns an exit code greater than 128, it is
+interpreted as a signal. @code{process-file} requires to return a
+string describing this signal.
+
+Since there are processes violating this rule, returning exit codes
+greater than 128 which are not bound to a signal, @code{process-file}
+returns always the exit code as natural number for remote processes.
+Setting this user option to non-nil forces @code{process-file} to
+interpret such exit codes as signals, and to return a corresponding
+string.
+@end defopt
+
@defun call-process-region start end program &optional delete destination
display &rest args
This function sends the text from @var{start} to @var{end} as
standard input to a process running @var{program}. It deletes the text
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 83c1549..c8a12bd 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -338,16 +338,14 @@ first tries to match all three @samp{a}s; but the rest of
the pattern is
The next alternative is for @samp{a*} to match only two @samp{a}s. With
this choice, the rest of the regexp matches successfully.
-@strong{Warning:} Nested repetition operators can run for an
-indefinitely long time, if they lead to ambiguous matching. For
+@strong{Warning:} Nested repetition operators can run for a very
+long time, if they lead to ambiguous matching. For
example, trying to match the regular expression @samp{\(x+y*\)*a}
against the string @samp{xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxz} could
take hours before it ultimately fails. Emacs must try each way of
grouping the @samp{x}s before concluding that none of them can work.
-Even worse, @samp{\(x*\)*} can match the null string in infinitely
-many ways, so it causes an infinite loop. To avoid these problems,
-check nested repetitions carefully, to make sure that they do not
-cause combinatorial explosions in backtracking.
+In general, avoid expressions that can match the same string in
+multiple ways.
@item @samp{+}
@cindex @samp{+} in regexp
diff --git a/doc/lispref/sequences.texi b/doc/lispref/sequences.texi
index 1cb0d05..91c3049 100644
--- a/doc/lispref/sequences.texi
+++ b/doc/lispref/sequences.texi
@@ -183,11 +183,11 @@ for other ways to copy sequences.
@example
@group
-(setq bar (list 1 2)) ; @r{Create a mutable list.}
+(setq bar (list 1 2))
@result{} (1 2)
@end group
@group
-(setq x (vector 'foo bar)) ; @r{Create a mutable vector.}
+(setq x (vector 'foo bar))
@result{} [foo (1 2)]
@end group
@group
@@ -278,7 +278,7 @@ Unlike @code{reverse} the original @var{sequence} may be
modified.
@example
@group
-(setq x (list 'a 'b 'c)) ; @r{Create a mutable list.}
+(setq x (list 'a 'b 'c))
@result{} (a b c)
@end group
@group
@@ -320,7 +320,7 @@ presented graphically:
For the vector, it is even simpler because you don't need setq:
@example
-(setq x (copy-sequence [1 2 3 4])) ; @r{Create a mutable vector.}
+(setq x (copy-sequence [1 2 3 4]))
@result{} [1 2 3 4]
(nreverse x)
@result{} [4 3 2 1]
@@ -331,6 +331,7 @@ x
Note that unlike @code{reverse}, this function doesn't work with strings.
Although you can alter string data by using @code{aset}, it is strongly
encouraged to treat strings as immutable even when they are mutable.
+@xref{Mutability}.
@end defun
@@ -374,7 +375,7 @@ appears in a different position in the list due to the
change of
@example
@group
-(setq nums (list 1 3 2 6 5 4 0)) ; @r{Create a mutable list.}
+(setq nums (list 1 3 2 6 5 4 0))
@result{} (1 3 2 6 5 4 0)
@end group
@group
@@ -1228,7 +1229,7 @@ This function sets the @var{index}th element of
@var{array} to be
@example
@group
-(setq w (vector 'foo 'bar 'baz)) ; @r{Create a mutable vector.}
+(setq w (vector 'foo 'bar 'baz))
@result{} [foo bar baz]
(aset w 0 'fu)
@result{} fu
@@ -1237,7 +1238,7 @@ w
@end group
@group
-;; @r{@code{copy-sequence} creates a mutable string.}
+;; @r{@code{copy-sequence} copies the string to be modified later.}
(setq x (copy-sequence "asdfasfd"))
@result{} "asdfasfd"
(aset x 3 ?Z)
@@ -1247,9 +1248,7 @@ x
@end group
@end example
-The @var{array} should be mutable; that is, it should not be a constant,
-such as the constants created via quoting or via self-evaluating forms.
-@xref{Constants and Mutability}.
+The @var{array} should be mutable. @xref{Mutability}.
If @var{array} is a string and @var{object} is not a character, a
@code{wrong-type-argument} error results. The function converts a
@@ -1262,7 +1261,6 @@ each element of @var{array} is @var{object}. It returns
@var{array}.
@example
@group
-;; @r{Create a mutable vector and then fill it with zeros.}
(setq a (copy-sequence [a b c d e f g]))
@result{} [a b c d e f g]
(fillarray a 0)
@@ -1271,7 +1269,6 @@ a
@result{} [0 0 0 0 0 0 0]
@end group
@group
-;; @r{Create a mutable string and then fill it with "-".}
(setq s (copy-sequence "When in the course"))
@result{} "When in the course"
(fillarray s ?-)
@@ -1310,8 +1307,8 @@ same way in Lisp input.
evaluation: the result of evaluating it is the same vector. This does
not evaluate or even examine the elements of the vector.
@xref{Self-Evaluating Forms}. Vectors written with square brackets
-are constants and should not be modified via @code{aset} or other
-destructive operations. @xref{Constants and Mutability}.
+should not be modified via @code{aset} or other destructive
+operations. @xref{Mutability}.
Here are examples illustrating these principles:
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index a4c9c25..70c3b3c 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -49,10 +49,9 @@ by a distinguished character code.
Since strings are arrays, and therefore sequences as well, you can
operate on them with the general array and sequence functions documented
-in @ref{Sequences Arrays Vectors}. For example, you can access or
-change individual characters in a string using the functions @code{aref}
-and @code{aset} (@pxref{Array Functions}). However, you should not
-try to change the contents of constant strings (@pxref{Modifying Strings}).
+in @ref{Sequences Arrays Vectors}. For example, you can access
+individual characters in a string using the function @code{aref}
+(@pxref{Array Functions}).
There are two text representations for non-@acronym{ASCII}
characters in Emacs strings (and in buffers): unibyte and multibyte.
@@ -382,9 +381,7 @@ usual value is @w{@code{"[ \f\t\n\r\v]+"}}.
@cindex string modification
You can alter the contents of a mutable string via operations
-described in this section. However, you should not try to use these
-operations to alter the contents of a constant string.
-@xref{Constants and Mutability}.
+described in this section. @xref{Mutability}.
The most basic way to alter the contents of an existing string is with
@code{aset} (@pxref{Array Functions}). @code{(aset @var{string}
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 58424a4..9317362 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5161,6 +5161,9 @@ The following are functions for altering the
@acronym{DOM}.
@item dom-set-attribute @var{node} @var{attribute} @var{value}
Set the @var{attribute} of the node to @var{value}.
+@item dom-remove-attribute @var{node} @var{attribute}
+Remove @var{attribute} from @var{node}.
+
@item dom-append-child @var{node} @var{child}
Append @var{child} as the last child of @var{node}.
diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi
index 3b8da35..5b09b2c 100644
--- a/doc/lispref/tips.texi
+++ b/doc/lispref/tips.texi
@@ -821,6 +821,14 @@ most cases, the meaning is clear with just ``if''.
Otherwise, try to
find an alternate phrasing that conveys the meaning.
@item
+Try to avoid using abbreviations such as ``e.g.'' (for ``for
+example''), ``i.e.'' (for ``that is''), ``no.'' (for ``number''),
+``c.f.'' (for ``in contrast to'') and ``w.r.t.'' (for ``with respect
+to'') as much as possible. It is almost always clearer and easier to
+read the expanded version.@footnote{We do use these occasionally, but
+try not to overdo it.}
+
+@item
When a command is meaningful only in a certain mode or situation,
do mention that in the documentation string. For example,
the documentation of @code{dired-find-file} is:
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index f99a890..16eac48 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -2132,6 +2132,11 @@ For Pike autodoc markup, the standard in Pike.
@item gtkdoc
@cindex GtkDoc markup
For GtkDoc markup, widely used in the Gnome community.
+
+@item doxygen
+@cindex Doxygen markup
+For Doxygen markup, which can be used with C, C++, Java and variety of
+other languages.
@end table
The above is by no means complete. If you'd like to see support for
@@ -6390,6 +6395,26 @@ function is the same as specifying a list
@code{(c-lineup-assignments
@comment ------------------------------------------------------------
+@defun c-lineup-ternary-bodies
+@findex lineup-ternary-bodies @r{(c-)}
+Line up true and false branches of a ternary operator
+(i.e. @code{?:}). More precisely, if the line starts with a colon
+which is a part of a said operator it with corresponding question
+mark. For example:
+
+@example
+@group
+return arg % 2 == 0 ? arg / 2
+ : (3 * arg + 1); @hereFn{c-lineup-ternary-bodies}
+@end group
+@end example
+
+@workswith @code{arglist-cont}, @code{arglist-cont-nonempty} and
+@code{statement-cont}.
+@end defun
+
+@comment ------------------------------------------------------------
+
@defun c-lineup-cascaded-calls
@findex lineup-cascaded-calls @r{(c-)}
Line up ``cascaded calls'' under each other. If the line begins with
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 50a208d..be1ffc0 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -3463,22 +3463,16 @@ see @ref{Packages that do not come with Emacs}.
@cindex Emacs Lisp List
@cindex Emacs Lisp Archive
-The easiest way to add more features to your Emacs is to use the
-command @kbd{M-x list-packages}. This contacts the
-@uref{https://elpa.gnu.org, GNU ELPA} (``Emacs Lisp Package Archive'')
-server and fetches the list of additional packages that it offers.
-These are GNU packages that are available for use with Emacs, but are
-distributed separately from Emacs itself, for reasons of space, etc.
-You can browse the resulting @file{*Packages*} buffer to see what is
-available, and then Emacs can automatically download and install the
-packages that you select. @xref{Packages,,, emacs, The GNU Emacs Manual}.
-
-There are other, non-GNU, Emacs Lisp package servers, including:
-@uref{https://melpa.org, MELPA}; and
-@uref{https://marmalade-repo.org, Marmalade}. To use additional
-package servers, customize the @code{package-archives} variable. Be
-aware that installing a package can run arbitrary code, so only add
-sources that you trust.
+We distribute many packages that extend Emacs, in the
+@uref{https://elpa.gnu.org, GNU ELPA} (``Emacs Lisp Package
+Archive''). The command @kbd{M-x list-packages} contacts the GNU ELPA
+server and fetches the list of packages that it distributes. These
+GNU packages are designed for use with Emacs, but we distribute them
+separately from Emacs itself, for reasons of space, and convenience of
+development. You can browse the resulting @file{*Packages*} buffer to
+see what is available, and then Emacs can automatically download and
+install the packages that you select. @xref{Packages,,, emacs, The
+GNU Emacs Manual}.
The @uref{https://lists.gnu.org/mailman/listinfo/gnu-emacs-sources,
GNU Emacs sources mailing list}, which is gatewayed to the
diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi
index 42a7750..2f38dcd 100644
--- a/doc/misc/emacs-mime.texi
+++ b/doc/misc/emacs-mime.texi
@@ -917,7 +917,7 @@ Here's an example:
@lisp
(add-to-list 'gnus-newsgroup-variables 'mm-coding-system-priorities)
(setq gnus-parameters
- (nconc
+ (append
;; Some charsets are just examples!
'(("^cn\\." ;; Chinese
(mm-coding-system-priorities
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 57f7136..c33ca0e 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -159,6 +159,9 @@ The following persons have made contributions to Eshell.
@itemize @bullet
@item
+John Wiegley is the original author of Eshell.
+
+@item
Eli Zaretskii made it possible for Eshell to run without requiring
asynchronous subprocess support. This is important for MS-DOS, which
does not have such support.
diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex
index deca599..2b7b31b 100644
--- a/doc/misc/texinfo.tex
+++ b/doc/misc/texinfo.tex
@@ -3,9 +3,9 @@
% Load plain if necessary, i.e., if running under initex.
\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
%
-\def\texinfoversion{2020-02-11.09}
+\def\texinfoversion{2020-05-07.17}
%
-% Copyright 1985, 1986, 1988, 1990-2019 Free Software Foundation, Inc.
+% Copyright 1985, 1986, 1988, 1990-2020 Free Software Foundation, Inc.
%
% This texinfo.tex file is free software: you can redistribute it and/or
% modify it under the terms of the GNU General Public License as
@@ -349,34 +349,19 @@
\ifodd\pageno \advance\hoffset by \bindingoffset
\else \advance\hoffset by -\bindingoffset\fi
%
+ \checkchapterpage
+ %
% Retrieve the information for the headings from the marks in the page,
% and call Plain TeX's \makeheadline and \makefootline, which use the
% values in \headline and \footline.
%
- % This is used to check if we are on the first page of a chapter.
- \ifcase1\the\savedtopmark\fi
- \let\prevchaptername\thischaptername
- \ifcase0\firstmark\fi
- \let\curchaptername\thischaptername
- %
- \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi
- %
- \ifx\curchaptername\prevchaptername
- \let\thischapterheading\thischapter
- \else
- % \thischapterheading is the same as \thischapter except it is blank
- % for the first page of a chapter. This is to prevent the chapter name
- % being shown twice.
- \def\thischapterheading{}%
- \fi
- %
% Common context changes for both heading and footing.
% Do this outside of the \shipout so @code etc. will be expanded in
% the headline as they should be, not taken literally (outputting ''code).
\def\commonheadfootline{\let\hsize=\txipagewidth \texinfochars}
%
+ \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi
\global\setbox\headlinebox = \vbox{\commonheadfootline \makeheadline}%
- %
\ifodd\pageno \getoddfootingmarks \else \getevenfootingmarks \fi
\global\setbox\footlinebox = \vbox{\commonheadfootline \makefootline}%
%
@@ -423,6 +408,24 @@
\ifr@ggedbottom \kern-\dimen@ \vfil \fi}
}
+% Check if we are on the first page of a chapter.
+\def\checkchapterpage{%
+ % Get the chapter that was current at the end of the last page
+ \ifcase1\the\savedtopmark\fi
+ \let\prevchaptername\thischaptername
+ %
+ \ifodd\pageno \getoddheadingmarks \else \getevenheadingmarks \fi
+ \let\curchaptername\thischaptername
+ %
+ \ifx\curchaptername\prevchaptername
+ \let\thischapterheading\thischapter
+ \else
+ % \thischapterheading is the same as \thischapter except it is blank
+ % for the first page of a chapter. This is to prevent the chapter name
+ % being shown twice.
+ \def\thischapterheading{}%
+ \fi
+}
% Argument parsing
@@ -1427,7 +1430,13 @@ output) for that.)}
% subentries, which we calculated on our first read of the .toc above.
%
% We use the node names as the destinations.
+ %
+ % Currently we prefix the section name with the section number
+ % for chapter and appendix headings only in order to avoid too much
+ % horizontal space being required in the PDF viewer.
\def\numchapentry##1##2##3##4{%
+ \dopdfoutline{##2 ##1}{count-\expnumber{chap##2}}{##3}{##4}}%
+ \def\unnchapentry##1##2##3##4{%
\dopdfoutline{##1}{count-\expnumber{chap##2}}{##3}{##4}}%
\def\numsecentry##1##2##3##4{%
\dopdfoutline{##1}{count-\expnumber{sec##2}}{##3}{##4}}%
@@ -1669,9 +1678,13 @@ output) for that.)}
% Therefore, we read toc only once.
%
% We use node names as destinations.
+ %
+ % Currently we prefix the section name with the section number
+ % for chapter and appendix headings only in order to avoid too much
+ % horizontal space being required in the PDF viewer.
\def\partentry##1##2##3##4{}% ignore parts in the outlines
\def\numchapentry##1##2##3##4{%
- \dopdfoutline{##1}{1}{##3}{##4}}%
+ \dopdfoutline{##2 ##1}{1}{##3}{##4}}%
\def\numsecentry##1##2##3##4{%
\dopdfoutline{##1}{2}{##3}{##4}}%
\def\numsubsecentry##1##2##3##4{%
@@ -1683,7 +1696,8 @@ output) for that.)}
\let\appsecentry\numsecentry%
\let\appsubsecentry\numsubsecentry%
\let\appsubsubsecentry\numsubsubsecentry%
- \let\unnchapentry\numchapentry%
+ \def\unnchapentry##1##2##3##4{%
+ \dopdfoutline{##1}{1}{##3}{##4}}%
\let\unnsecentry\numsecentry%
\let\unnsubsecentry\numsubsecentry%
\let\unnsubsubsecentry\numsubsubsecentry%
@@ -2496,7 +2510,7 @@ end
\def\it{\fam=\itfam \setfontstyle{it}}
\def\sl{\fam=\slfam \setfontstyle{sl}}
\def\bf{\fam=\bffam \setfontstyle{bf}}\def\bfstylename{bf}
-\def\tt{\fam=\ttfam \setfontstyle{tt}}
+\def\tt{\fam=\ttfam \setfontstyle{tt}}\def\ttstylename{tt}
% Texinfo sort of supports the sans serif font style, which plain TeX does not.
% So we set up a \sf.
@@ -3101,10 +3115,10 @@ end
% Allow a ragged right output to aid breaking long URL's. There can
% be a break at the \allowbreak with no extra glue (if the existing stretch in
-% the line is sufficent), a break at the \penalty100 with extra glue added
+% the line is sufficient), a break at the \penalty100 with extra glue added
% at the end of the line, or no break at all here.
% Changing the value of the penalty and/or the amount of stretch affects how
-% preferrable one choice is over the other.
+% preferable one choice is over the other.
\def\urefallowbreak{%
\allowbreak
\hskip 0pt plus 2 em\relax
@@ -3509,7 +3523,7 @@ end
% @pounds{} is a sterling sign, which Knuth put in the CM italic font.
%
-\def\pounds{{\it\$}}
+\def\pounds{\ifmonospace{\ecfont\char"BF}\else{\it\$}\fi}
% @euro{} comes from a separate font, depending on the current style.
% We use the free feym* fonts from the eurosym package by Henrik
@@ -3658,11 +3672,19 @@ end
\fi
% Quotes.
-\chardef\quotedblleft="5C
-\chardef\quotedblright=`\"
\chardef\quoteleft=`\`
\chardef\quoteright=`\'
+% only change font for tt for correct kerning and to avoid using
+% \ecfont unless necessary.
+\def\quotedblleft{%
+ \ifmonospace{\ecfont\char"10}\else{\char"5C}\fi
+}
+
+\def\quotedblright{%
+ \ifmonospace{\ecfont\char"11}\else{\char`\"}\fi
+}
+
\message{page headings,}
@@ -7444,13 +7466,9 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\newdimen\tabw \setbox0=\hbox{\tt\space} \tabw=8\wd0 % tab amount
%
% We typeset each line of the verbatim in an \hbox, so we can handle
-% tabs. The \global is in case the verbatim line starts with an accent,
-% or some other command that starts with a begin-group. Otherwise, the
-% entire \verbbox would disappear at the corresponding end-group, before
-% it is typeset. Meanwhile, we can't have nested verbatim commands
-% (can we?), so the \global won't be overwriting itself.
+% tabs.
\newbox\verbbox
-\def\starttabbox{\global\setbox\verbbox=\hbox\bgroup}
+\def\starttabbox{\setbox\verbbox=\hbox\bgroup}
%
\begingroup
\catcode`\^^I=\active
@@ -7461,7 +7479,8 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\divide\dimen\verbbox by\tabw
\multiply\dimen\verbbox by\tabw % compute previous multiple of \tabw
\advance\dimen\verbbox by\tabw % advance to next multiple of \tabw
- \wd\verbbox=\dimen\verbbox \box\verbbox \starttabbox
+ \wd\verbbox=\dimen\verbbox
+ \leavevmode\box\verbbox \starttabbox
}%
}
\endgroup
@@ -7471,9 +7490,7 @@ might help (with 'rm \jobname.?? \jobname.??s')%
\let\nonarrowing = t%
\nonfillstart
\tt % easiest (and conventionally used) font for verbatim
- % The \leavevmode here is for blank lines. Otherwise, we would
- % never \starttabbox and the \egroup would end verbatim mode.
- \def\par{\leavevmode\egroup\box\verbbox\endgraf}%
+ \def\par{\egroup\box\verbbox\endgraf\starttabbox}%
\tabexpand
\setupmarkupstyle{verbatim}%
% Respect line breaks,
@@ -7481,7 +7498,6 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% make each space count.
% Must do in this order:
\obeylines \uncatcodespecials \sepspaces
- \everypar{\starttabbox}%
}
% Do the @verb magic: verbatim text is quoted by unique
@@ -7516,9 +7532,12 @@ might help (with 'rm \jobname.?? \jobname.??s')%
% ignore everything up to the first ^^M, that's the newline at the end
% of the @verbatim input line itself. Otherwise we get an extra blank
% line in the output.
- \xdef\doverbatim#1^^M#2@end verbatim{#2\noexpand\end\gobble verbatim}%
+ \xdef\doverbatim#1^^M#2@end verbatim{%
+ \starttabbox#2\egroup\noexpand\end\gobble verbatim}%
% We really want {...\end verbatim} in the body of the macro, but
% without the active space; thus we have to use \xdef and \gobble.
+ % The \egroup ends the \verbbox started at the end of the last line in
+ % the block.
\endgroup
%
\envdef\verbatim{%
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 0b13c17..d1688de 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -318,14 +318,14 @@ behind the scenes when you open a file with @value{tramp}.
@uref{https://ftp.gnu.org/gnu/tramp/}. The version number of
@value{tramp} can be obtained by the variable @code{tramp-version}.
For released @value{tramp} versions, this is a three-number string
-like ``2.4.2''.
+like ``2.4.3''.
A @value{tramp} release, which is packaged with Emacs, could differ
slightly from the corresponding standalone release. This is because
it isn't always possible to synchronize release dates between Emacs
and @value{tramp}. Such version numbers have the Emacs version number
-as suffix, like ``2.3.5.26.3''. This means @w{@value{tramp} 2.3.5} as
-integrated in @w{Emacs 26.3}. A complete list of @value{tramp}
+as suffix, like ``2.4.3.27.1''. This means @w{@value{tramp} 2.4.3} as
+integrated in @w{Emacs 27.1}. A complete list of @value{tramp}
versions packaged with Emacs can be retrieved by
@vindex customize-package-emacs-version-alist
@@ -337,12 +337,12 @@ versions packaged with Emacs can be retrieved by
ELPA} package. Besides the standalone releases, further minor version
of @value{tramp} will appear on GNU ELPA, until the next @value{tramp}
release appears. These minor versions have a four-number string, like
-``2.4.2.1''.
+``2.4.3.1''.
@value{tramp} development versions are available on Git servers.
Development versions contain new and incomplete features. The
development version of @value{tramp} is always the version number of
-the next release, plus the suffix ``-pre'', like ``2.4.3-pre''.
+the next release, plus the suffix ``-pre'', like ``2.4.4-pre''.
One way to obtain @value{tramp} from Git server is to visit the
Savannah project page at the following URL and then clicking on the
@@ -2315,7 +2315,7 @@ string of that environment variable looks always like
@example
@group
echo $INSIDE_EMACS
-@result{} 26.2,tramp:2.3.4
+@result{} 27.1,tramp:2.4.3
@end group
@end example
@@ -3050,6 +3050,17 @@ host when the variable @code{default-directory} is
remote:
@end group
@end lisp
+@vindex process-file-return-signal-string
+@code{process-file} shall return either the exit code of the process,
+or a string describing the signal, when the process has been
+interrupted. Since it cannot be determined reliably whether a remote
+process has been interrupted, @code{process-file} returns always the
+exit code. When the user option
+@code{process-file-return-signal-string} is non-nil,
+@code{process-file} regards all exit codes greater than 128 as an
+indication that the process has been interrupted, and returns a
+respective string.
+
Remote processes do not apply to @acronym{GVFS} (see @ref{GVFS-based
methods}) because the remote file system is mounted on the local host
and @value{tramp} just accesses by changing the
@@ -3057,9 +3068,17 @@ and @value{tramp} just accesses by changing the
@value{tramp} starts a remote process when a command is executed in a
remote file or directory buffer. As of now, these packages have been
-integrated to work with @value{tramp}: @file{compile.el} (commands
-like @code{compile} and @code{grep}) and @file{gud.el} (@code{gdb} or
-@code{perldb}).
+integrated to work with @value{tramp}: @file{shell.el},
+@file{eshell.el}, @file{compile.el} (commands like @code{compile} and
+@code{grep}) and @file{gud.el} (@code{gdb} or @code{perldb}).
+
+@vindex INSIDE_EMACS@r{, environment variable}
+@value{tramp} always modifies the @env{INSIDE_EMACS} environment
+variable for remote processes. Per default, this environment variable
+shows the Emacs version. @value{tramp} adds its own version string,
+so it looks like @samp{27.1,tramp:2.4.3.1}. However, other packages
+might also add their name to this environment variable, like
+@samp{27.1,comint,tramp:2.4.3.1}.
For @value{tramp} to find the command on the remote, it must be
accessible through the default search path as setup by @value{tramp}
@@ -3254,7 +3273,7 @@ variables.
@vindex async-shell-command-width
@vindex COLUMNS@r{, environment variable}
If Emacs supports the variable @code{async-shell-command-width} (since
-@w{Emacs 27.1}), @value{tramp} cares about its value for asynchronous
+@w{Emacs 27}), @value{tramp} cares about its value for asynchronous
shell commands. It specifies the number of display columns for
command output. For synchronous shell commands, a similar effect can
be achieved by adding the environment variable @env{COLUMNS} to
@@ -3741,7 +3760,7 @@ row are possible, like
@file{/path/to/dir/file.tar.gz.uu/dir/file}.
@vindex tramp-archive-all-gvfs-methods
An archive file name could be a remote file name, as in
-@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}.
+@file{/ftp:anonymous@@ftp.gnu.org:/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}.
Since all file operations are mapped internally to @acronym{GVFS}
operations, remote file names supported by @code{tramp-gvfs} perform
better, because no local copy of the file archive must be downloaded
@@ -3752,7 +3771,7 @@ the similar @samp{/scp:user@@host:...}. See the constant
If @code{url-handler-mode} is enabled, archives could be visited via
URLs, like
-@file{https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/INSTALL}. This
+@file{https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/INSTALL}. This
allows complex file operations like
@lisp
@@ -3760,8 +3779,8 @@ allows complex file operations like
(progn
(url-handler-mode 1)
(ediff-directories
- "https://ftp.gnu.org/gnu/tramp/tramp-2.3.1.tar.gz/tramp-2.3.1";
- "https://ftp.gnu.org/gnu/tramp/tramp-2.3.2.tar.gz/tramp-2.3.2"; ""))
+ "https://ftp.gnu.org/gnu/tramp/tramp-2.4.2.tar.gz/tramp-2.4.2";
+ "https://ftp.gnu.org/gnu/tramp/tramp-2.4.3.tar.gz/tramp-2.4.3"; ""))
@end group
@end lisp
diff --git a/etc/NEWS b/etc/NEWS
index 025d5c1..e97755a 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -98,20 +98,29 @@ shows equivalent key bindings for all commands that have
them.
'gomoku-move-sw' and 'gomoku-move-ne' now work correctly, and
horizontal movements now stop at the edge of the board.
+** Autosaving via 'auto-save-visited-mode' can now be inhibited by
+setting the variable 'auto-save-visited-mode' buffer-locally to nil.
+
* Changes in Specialized Modes and Packages in Emacs 28.1
-** New minor mode 'cl-font-lock-built-in-mode' for `lisp-mode'
+** EIEIO: 'oset' and 'oset-default' are declared obsolete.
+
+** New minor mode 'cl-font-lock-built-in-mode' for `lisp-mode'.
The mode provides refined highlighting of built-in functions, types,
and variables.
-** archive-mode
+** Archive mode
+
*** Can now modify members of 'ar' archives.
-*** Display of summaries unified between backends
-*** New var 'archive-hidden-columns' and cmd 'archive-hideshow-column'
-These let you control which columns are displayed and which are kept hidden
-** Emacs-Lisp mode
+*** Display of summaries unified between backends.
+
+*** New user option 'archive-hidden-columns' and command
+'archive-hideshow-column'. These let you control which columns are
+displayed and which are kept hidden.
+
+** Emacs Lisp mode
*** The mode-line now indicates whether we're using lexical or dynamic scoping.
@@ -133,6 +142,9 @@ directories with the help of new command
'dired-vc-next-action'.
*** New commands 'vc-dir-mark-registered-files' (bound to '* r') and
'vc-dir-mark-unregistered-files'.
+*** Support for bookmark.el.
+Bookmark locations can refer to VC directory buffers.
+
** Gnus
---
@@ -156,7 +168,7 @@ this user option.
This file was a compatibility kludge which is no longer needed.
---
-** 'lisp-mode' now uses 'common-lisp-indent-function'.
+** Lisp mode now uses 'common-lisp-indent-function'.
To revert to the previous behaviour,
'(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'.
@@ -182,7 +194,7 @@ their backends.
** Eshell
---
-*** Environment variable INSIDE_EMACS is now copied to subprocesses.
+*** Environment variable 'INSIDE_EMACS' is now copied to subprocesses.
Its value equals the result of evaluating '(format "%s,eshell" emacs-version)'.
** Tramp
@@ -198,7 +210,6 @@ like cell phones, tablets or cameras.
Previously, assigning a new template to an already defined tag had no
effect.
-
** map.el
*** Pcase 'map' pattern added keyword symbols abbreviation.
@@ -218,8 +229,15 @@ key binding
/ n package-menu-filter-by-name
/ s package-menu-filter-by-status
/ v package-menu-filter-by-version
+/ m package-menu-filter-marked
/ / package-menu-filter-clear
+---
++++ Column widths in 'list-packages' display can now be customized.
+See the new user options 'package-name-column-width',
+'package-version-column-width', 'package-status-column-width', and
+'package-archive-column-width'.
+
** gdb-mi
+++
@@ -238,7 +256,7 @@ it after GDB quits. A toggle button is also provided under
'Gud --
GDB-Windows'.
+++
-*** gdb-mi now has a better logic for displaying source buffers
+*** gdb-mi now has a better logic for displaying source buffers.
Now GDB only uses one source window to display source file by default.
Customize 'gdb-max-source-window-count' to use more than one window.
Control source file display by 'gdb-display-source-buffer-action'.
@@ -257,11 +275,11 @@ case-insensitive matching of messages when the old
behaviour is
required, but the recommended solution is to use a correctly matching
regexp instead.
-** Hi-Lock
+** Hi Lock mode
---
*** Matching in 'hi-lock-mode' is case-sensitive when regexp contains
-upper case characters and `search-upper-case' is non-nil.
+upper case characters and 'search-upper-case' is non-nil.
'highlight-phrase' also uses 'search-whitespace-regexp'
to substitute spaces in regexp search.
@@ -272,13 +290,13 @@ The new default value is 2000000 (2 megabytes).
** Texinfo
---
-*** New customizable option 'texinfo-texi2dvi-options'.
+*** New user option 'texinfo-texi2dvi-options'.
This is used when invoking 'texi2dvi' from 'texinfo-tex-buffer'.
** Rmail
---
-*** New customizable option 'rmail-re-abbrevs'.
+*** New user option 'rmail-re-abbrevs'.
Its default value matches localized abbreviations of the "reply"
prefix on the Subject line in various languages.
@@ -288,9 +306,117 @@ prefix on the Subject line in various languages.
These new navigation commands are bound to 'n' and 'p' in
'apropos-mode'.
+** CC mode
+
+*** Added support for Doxygen documentation style.
+'doxygen' is now a valid 'c-doc-comment-style' which recognises all
+comment styles supported by Doxygen (namely '///', '//!', '/** … */'
+and '/*! … */'. 'gtkdoc' remains the default for C and C++ modes; to
+use 'doxygen' by default one might evaluate:
+
+ (setq-default c-doc-comment-style
+ '((java-mode . javadoc)
+ (pike-mode . autodoc)
+ (c-mode . doxygen)
+ (c++-mode . doxygen)))
+
+or use it in a custom 'c-style'.
+
+*** Added support to line up '?' and ':' of a ternary operator.
+The new 'c-lineup-ternary-bodies' function can be used as a lineup
+function to align question mark and colon which are part of a ternary
+operator ('?:'). For example:
+
+ return arg % 2 == 0 ? arg / 2
+ : (3 * arg + 1);
+
+To enable, add it to appropriate entries in 'c-offsets-alist', e.g.:
+
+ (c-set-offset 'arglist-cont '(c-lineup-ternary-bodies
+ c-lineup-gcc-asm-reg))
+ (c-set-offset 'arglist-cont-nonempty '(c-lineup-ternary-bodies
+ c-lineup-gcc-asm-reg
+ c-lineup-arglist))
+ (c-set-offset 'statement-cont '(c-lineup-ternary-bodies +))
+
+** browse-url
+
+*** Added support for custom URL handlers.
+
+There is a new variable 'browse-url-default-handlers' and a user
+option 'browse-url-handlers' being alists with '(REGEXP-OR-PREDICATE
+. FUNCTION)' entries allowing to define different browsing FUNCTIONs
+depending on the URL to be browsed. The variable is for default
+handlers provided by Emacs itself or external packages, the user
+option is for the user (and allows for overriding the default
+handlers).
+
+Formerly, one could do the same by setting
+'browse-url-browser-function' to such an alist. This usage is still
+supported but deprecated.
+
+*** Categorization of browsing functions in internal vs. external.
+
+All standard browsing functions such as 'browse-url-firefox',
+'browse-url-mail', or 'eww' have been categorized into internal (URL
+is browsed in Emacs) or external (an external application is spawned
+with the URL). This is done by adding a 'browse-url-browser-kind'
+symbol property to the browsing functions. With a new command
+'browse-url-with-browser-kind', an URL can explicitly be browsed with
+either an internal or external browser.
+
+*** Support for the conkeror browser is now obsolete.
+
+** SHR
+
+---
+*** The command 'shr-browse-url' now supports custom mailto handlers.
+Clicking on or otherwise following a 'mailto:' link in a HTML buffer
+rendered by SHR previously invoked the command 'browse-url-mailto'.
+This is still the case by default, but if you customize
+'browse-url-mailto-function' or 'browse-url-handlers' to call some
+other function, it will now be called instead of the default.
+
+** EWW
+
+---
+*** The command 'eww-follow-link' now supports custom mailto handlers.
+The function that is invoked when clicking on or otherwise following a
+'mailto:' link in an EWW buffer can now be customized. For more
+information, see the related entry about 'shr-browse-url' above.
+
+** Project
+
+*** New user option 'project-vc-merge-submodules'.
+
+** json.el
+
+---
+*** JSON number parsing is now stricter.
+Numbers with a leading plus sign, leading zeros, or a missing integer
+component are now rejected by 'json-read' and friends. This makes
+them more compliant with the JSON specification and consistent with
+the native JSON parsing functions.
+
+** xml.el
+
+*** XML serialization functions now reject invalid characters.
+Previously 'xml-print' would produce invalid XML when given a string
+with characters that are not valid in XML (see
+https://www.w3.org/TR/xml/#charsets). Now it rejects such strings.
+
+** The metamail.el library is now marked obsolete.
+
* New Modes and Packages in Emacs 28.1
+** Lisp Data mode
+
+The new command 'lisp-data-mode' enables a major mode for buffers
+composed of Lisp symbolic expressions that do not form a computer
+program. The ".dir-locals.el" file is automatically set to use this
+mode, as are other data files produced by Emacs.
+
* Incompatible Editing Changes in Emacs 28.1
@@ -331,9 +457,17 @@ This is no longer supported, and setting this variable has
no effect.
** The macro 'with-displayed-buffer-window' is now obsolete.
Use macro 'with-current-buffer-window' with action alist entry 'body-function'.
+---
+** Some libraries obsolete since Emacs 23 have been removed:
+'ledit.el', 'lmenu.el', 'lucid.el and 'old-whitespace.el'.
+
* Lisp Changes in Emacs 28.1
++++
+** New function 'file-modes-number-to-symbolic' to convert a numeric
+file mode specification into symbolic form.
+
** New macro 'dlet' to dynamically bind variables.
** The variable 'force-new-style-backquotes' has been removed.
@@ -358,24 +492,32 @@ optional argument specifying whether to follow symbolic
links.
** 'parse-time-string' can now parse ISO 8601 format strings,
such as "2020-01-15T16:12:21-08:00".
++++
+** The new function 'dom-remove-attribute' has been added.
+
---
-** 'make-network-process', 'make-serial-process' :coding behavior change.
-Previously, passing ":coding nil" to either of these functions would
+** 'make-network-process', 'make-serial-process' ':coding' behavior change.
+Previously, passing ':coding nil' to either of these functions would
override any non-nil binding for 'coding-system-for-read' and
'coding-system-for-write'. For consistency with 'make-process' and
-'make-pipe-process', passing ":coding nil" is now ignored. No code in
+'make-pipe-process', passing ':coding nil' is now ignored. No code in
Emacs depended on the previous behavior; if you really want the
process' coding-system to be nil, use 'set-process-coding-system'
-after the process has been created, or pass in ":coding '(nil nil)".
+after the process has been created, or pass in ':coding '(nil nil)'.
+++
-** 'open-network-stream' now accepts a :coding argument.
+** 'open-network-stream' now accepts a ':coding' argument.
This allows specifying the coding systems used by a network process
for encoding and decoding without having to bind
-coding-system-for-{read,write} or call 'set-process-coding-system'.
+'coding-system-for-{read,write}' or call 'set-process-coding-system'.
+
++++
+** 'open-gnutls-stream' now also accepts a ':coding' argument.
+++
-** 'open-gnutls-stream' now also accepts a :coding argument.
+** New user option 'process-file-return-signal-string'.
+It controls, whether 'process-file' returns a string when a remote
+process is interrupted by a signal.
* Changes in Emacs 28.1 on Non-Free Operating Systems
@@ -396,12 +538,12 @@ current IME activation status.
** On MS-Windows, Emacs can now use the native image API to display images.
Emacs can now use the MS-Windows GDI+ library to load and display
images in JPEG, PNG, GIF and TIFF formats. This support is enabled
-unless Emacs was configured --without-native-image-api.
+unless Emacs was configured '--without-native-image-api'.
This feature is experimental, and needs to be turned on to be used.
To turn this on, set the variable 'w32-use-native-image-API' to a
non-nil value. Please report any bugs you find while using the native
-image API via "M-x report-emacs-bug".
+image API via 'M-x report-emacs-bug'.
----------------------------------------------------------------------
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index 1eb391f..bb275b7 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -28,7 +28,7 @@ applies, and please also update docstrings as needed.
** Emacs now uses GMP, the GNU Multiple Precision library.
By default, if 'configure' does not find a suitable libgmp, it
arranges for the included mini-gmp library to be built and used.
-The new 'configure' option '--without-libgmp' uses mini-gmp even if a
+The new configure option '--without-libgmp' uses mini-gmp even if a
suitable libgmp is available.
---
@@ -132,7 +132,7 @@ can enable it when configuring, e.g., './configure
CFLAGS="-g3 -O2
** Emacs now normally uses a C pointer type instead of a C integer
type to implement Lisp_Object, which is the fundamental machine word
type internal to the Emacs Lisp interpreter. This change aims to
-catch typos and supports '-fcheck-pointer-bounds'. The 'configure'
+catch typos and supports '-fcheck-pointer-bounds'. The configure
option '--enable-check-lisp-object-type' is therefore no longer as
useful and so is no longer enabled by default in developer builds,
to reduce differences between developer and production builds.
@@ -868,7 +868,7 @@ to allow controlling how the conversion to text is done.
+++
*** The prefix key 's' was changed to 'c' for slicing commands
-to avoid conflicts with image-mode key 's'. The new key 'c' still
+to avoid conflicts with 'image-mode' key 's'. The new key 'c' still
has good mnemonics of "cut", "clip", "crop".
** Ido
@@ -881,21 +881,27 @@ list the contents of such directories when completing
file names.
** Minibuffer
+++
-*** A new user option, 'minibuffer-beginning-of-buffer-movement', has
-been introduced to allow controlling how the 'M-<' command works in
+*** New user option 'minibuffer-beginning-of-buffer-movement'.
+This option allows control of how the 'M-<' command works in
the minibuffer. If non-nil, point will move to the end of the prompt
-(if point is after the end of the prompt).
+(if point is after the end of the prompt). The default is nil, which
+preserves the original behavior of 'M-<' moving to the beginning of
+the prompt.
+++
*** When the minibuffer is active, echo-area messages are displayed at
the end of the minibuffer instead of hiding the minibuffer by the echo
area display. The new user option 'minibuffer-message-clear-timeout'
controls how messages displayed in this situation are removed from the
-minibuffer.
+minibuffer. To revert to previous behavior, where echo-area messages
+temporarily overwrote the minibuffer contents until the user typed
+something, set 'set-message-function' and 'clear-message-function' to
+nil.
---
*** Minibuffer now uses 'minibuffer-message' to display error messages
-at the end of the active minibuffer.
+at the end of the active minibuffer. To disable this, remove
+'minibuffer-error-initialize' from 'minibuffer-setup-hook'.
+++
*** 'y-or-n-p' now uses the minibuffer to read 'y' or 'n' answer.
@@ -2090,11 +2096,11 @@ variable for remote shells. It still defaults to
"/bin/sh".
+++
*** New values of 'shell-command-dont-erase-buffer'.
-This option can now have the value 'erase' to force to erase the
+This user option can now have the value 'erase' to force to erase the
output buffer before execution of the command, even if the output goes
to the current buffer. Additional values 'beg-last-out',
'end-last-out', and 'save-point' control where to put point in the
-output buffer after inserting the shell-command output.
+output buffer after inserting the 'shell-command' output.
---
*** The new functions 'shell-command-save-pos-or-erase' and
@@ -3538,9 +3544,9 @@ With a prefix argument, 'image-rotate' now rotates the
image at point
By default, the image will resize upon first display and whenever the
window's dimensions change. Two user options 'image-auto-resize' and
'image-auto-resize-on-window-resize' control the resizing behavior
-(including the possibility to disable auto-resizing). A new key
-prefix 's' contains the commands that can be used to fit the image to
-the window manually.
+(including the possibility to disable auto-resizing). A new prefix
+key 's' contains the commands that can be used to fit the image to the
+window manually.
---
*** Some 'image-mode' variables are now buffer-local.
diff --git a/etc/TODO b/etc/TODO
index 20262a7..0f908de 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -220,10 +220,23 @@ https://lists.gnu.org/r/emacs-devel/2013-11/msg00515.html
width fonts. However, more features are still needed to achieve this.
** Support ligatures out of the box
-For the list of typographical ligatures, see
+For the list of frequently-used typographical ligatures, see
https://en.wikipedia.org/wiki/Orthographic_ligature#Ligatures_in_Unicode_(Latin_alphabets)
+(Note that in general, the number of possible ligatures can be much
+larger, and there's no way, in principle, to specify the superset of
+all the ligatures that could exist. Each font can support different
+ligatures. The reliable way of supporting any and all ligatures is to
+hand all text to be displayed to the shaping engine and get back the
+font glyphs to display that text. However, doing this is impossible
+with the current design of the Emacs display engine, since it examines
+buffer text one character at a time, and implements character
+composition by calls to Lisp, which makes doing this for every
+character impractically slow. Therefore, the rest of this item
+describes a limited form of ligature support which is compatible with
+the current display engine design and uses automatic compositions.)
+
For Text and derived modes, the job is to figure out which ligatures
we want to support, how to let the user customize that, and probably
define a minor mode for automatic ligation (as some contexts might not
@@ -237,12 +250,12 @@ prettify-symbols-mode. We need to figure out which
ligatures are
needed for each programming language, and provide user options to turn
this on and off.
-The implementation should use the infrastructure for character
-compositions, i.e., we should define appropriate regexp-based rules
-for character sequences that need to be composed into ligatures, and
-populate composition-function-table with those rules. See
-composite.el for examples of this, and also grep lisp/language/*.el
-for references to composition-function-table.
+The implementation should use the infrastructure for automatic
+character compositions, i.e., we should define appropriate
+regexp-based rules for character sequences that need to be composed
+into ligatures, and populate composition-function-table with those
+rules. See composite.el for examples of this, and also grep
+lisp/language/*.el for references to composition-function-table.
One problem with character compositions that will need to be solved is
that composition-function-table, the char-table which holds the
@@ -259,11 +272,46 @@ way of preventing the ligation from happening. One
possibility is to
have a ZWNJ character separate these ASCII characters; another
possibility is to introduce a special text property that prevents
character composition, and place that property on the relevant parts
-of the mode line.
+of the mode line. Yet another possibility would be to write a
+specialized composition function, which would detect that it is called
+on mode-line strings, and return nil to signal that composition is not
+possible in this case; then use that function in the rules for
+ligatures stored in composition-function-table.
The prettify-symbols-mode should be deprecated once ligature support
is in place.
+A related, but somewhat independent, feature is being able to move the
+cursor "into a ligature", whereby cursor motion commands shows some
+pseudo-cursor on some part of a ligature. For example, if "ffi" is
+displayed as a ligature, then moving by one buffer position should
+show the middle part of the ligature's glyph similar to the cursor
+display: some special background and perhaps also a special
+foreground. There are two possible ways of figuring out the offset at
+which to display the pseudo-cursor:
+
+ . Arbitrarily divide the ligature's glyph width W into N parts,
+ where N is the number of codepoints composed into the ligature, then
+ move that pseudo-cursor by W/N pixels each time a cursor-motion
+ command is invoked;
+ . Use the font information. For example, HarfBuzz has the
+ hb_ot_layout_get_ligature_carets API for that purpose. However,
+ it could be that few fonts actually have that information recorded
+ in them, in which case the previous heuristics will be needed as
+ fallback.
+
+One subtle issue needs to be resolved to have this feature of
+"sub-glyph" cursor movement inside composed characters. The way Emacs
+currently displays the default block cursor is by simply redrawing the
+glyph at point in reverse video. So Emacs currently doesn't have a
+way of displaying a cursor that "covers" only part of a glyph. To
+make this happen, the display code will probably need to be changed to
+draw the cursor as part of drawing the foreground and/or background of
+the corresponding glyph, which is against the current flow of the
+display code: it generally first completely draws the background and
+foreground of the entire text that needs to be redrawn, and only then
+draws the cursor where it should be placed.
+
** Support for Stylistic Sets
This will allow using "alternate glyphs" supported by modern fonts.
For an overview of this feature, see
diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el
index 8161dbd..ff9af0c 100644
--- a/etc/themes/misterioso-theme.el
+++ b/etc/themes/misterioso-theme.el
@@ -63,6 +63,13 @@
`(button ((,class (:underline t))))
`(link ((,class (:foreground "#59e9ff" :underline t))))
`(link-visited ((,class (:foreground "#ed74cd" :underline t))))
+ ;; Ediff
+ `(ediff-even-diff-A ((,class (:background "#1d2430"))))
+ `(ediff-even-diff-B ((,class (:background "#1d2430"))))
+ `(ediff-even-diff-C ((,class (:background "#1d2430"))))
+ `(ediff-odd-diff-A ((,class (:background "#415160"))))
+ `(ediff-odd-diff-B ((,class (:background "#415160"))))
+ `(ediff-odd-diff-C ((,class (:background "#415160"))))
;; Gnus faces
`(gnus-group-news-1 ((,class (:foreground "#ff4242" :weight bold))))
`(gnus-group-news-1-low ((,class (:foreground "#ff4242"))))
diff --git a/lib-src/etags.c b/lib-src/etags.c
index eee2c59..4672e34 100644
--- a/lib-src/etags.c
+++ b/lib-src/etags.c
@@ -4197,9 +4197,9 @@ C_entries (int c_ext, FILE *inf)
break;
}
FALLTHROUGH;
- resetfvdef:
case '#': case '~': case '&': case '%': case '/':
case '|': case '^': case '!': case '.': case '?':
+ resetfvdef:
if (definedef != dnone)
break;
/* These surely cannot follow a function tag in C. */
diff --git a/lib/attribute.h b/lib/attribute.h
new file mode 100644
index 0000000..2836b99
--- /dev/null
+++ b/lib/attribute.h
@@ -0,0 +1,215 @@
+/* ATTRIBUTE_* macros for using attributes in GCC and similar compilers
+
+ Copyright 2020 Free Software Foundation, Inc.
+
+ This program is free software: you can redistribute it and/or modify it
+ under the terms of the GNU General Public License as published
+ by the Free Software Foundation; either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see <https://www.gnu.org/licenses/>. */
+
+/* Written by Paul Eggert. */
+
+/* Provide public ATTRIBUTE_* names for the private _GL_ATTRIBUTE_*
+ macros used within Gnulib. */
+
+/* These attributes can be placed in two ways:
+ - At the start of a declaration (i.e. even before storage-class
+ specifiers!); then they apply to all entities that are declared
+ by the declaration.
+ - Immediately after the name of an entity being declared by the
+ declaration; then they apply to that entity only. */
+
+#ifndef _GL_ATTRIBUTE_H
+#define _GL_ATTRIBUTE_H
+
+
+/* This file defines two types of attributes:
+ * C2X standard attributes. These have macro names that do not begin with
+ 'ATTRIBUTE_'.
+ * Selected GCC attributes; see:
+ https://gcc.gnu.org/onlinedocs/gcc/Common-Function-Attributes.html
+ https://gcc.gnu.org/onlinedocs/gcc/Common-Variable-Attributes.html
+ https://gcc.gnu.org/onlinedocs/gcc/Common-Type-Attributes.html
+ These names begin with 'ATTRIBUTE_' to avoid name clashes. */
+
+
+/* =============== Attributes for specific kinds of functions ===============
*/
+
+/* Attributes for functions that should not be used. */
+
+/* Warn if the entity is used. */
+/* Applies to:
+ - function, variable,
+ - struct, union, struct/union member,
+ - enumeration, enumeration item,
+ - typedef,
+ in C++ also: namespace, class, template specialization. */
+#define DEPRECATED _GL_ATTRIBUTE_DEPRECATED
+
+/* If a function call is not optimized way, warn with MSG. */
+/* Applies to: functions. */
+#define ATTRIBUTE_WARNING(msg) _GL_ATTRIBUTE_WARNING (msg)
+
+/* If a function call is not optimized way, report an error with MSG. */
+/* Applies to: functions. */
+#define ATTRIBUTE_ERROR(msg) _GL_ATTRIBUTE_ERROR (msg)
+
+
+/* Attributes for memory-allocating functions. */
+
+/* The function returns a pointer to freshly allocated memory. */
+/* Applies to: functions. */
+#define ATTRIBUTE_MALLOC _GL_ATTRIBUTE_MALLOC
+
+/* ATTRIBUTE_ALLOC_SIZE ((N)) - The Nth argument of the function
+ is the size of the returned memory block.
+ ATTRIBUTE_ALLOC_SIZE ((M, N)) - Multiply the Mth and Nth arguments
+ to determine the size of the returned memory block. */
+/* Applies to: function, pointer to function, function types. */
+#define ATTRIBUTE_ALLOC_SIZE(args) _GL_ATTRIBUTE_ALLOC_SIZE (args)
+
+
+/* Attributes for variadic functions. */
+
+/* The variadic function expects a trailing NULL argument.
+ ATTRIBUTE_SENTINEL () - The last argument is NULL.
+ ATTRIBUTE_SENTINEL ((N)) - The (N+1)st argument from the end is NULL. */
+/* Applies to: functions. */
+#define ATTRIBUTE_SENTINEL(pos) _GL_ATTRIBUTE_SENTINEL (pos)
+
+
+/* ================== Attributes for compiler diagnostics ================== */
+
+/* Attributes that help the compiler diagnose programmer mistakes.
+ Some of them may also help for some compiler optimizations. */
+
+/* ATTRIBUTE_FORMAT ((ARCHETYPE, STRING-INDEX, FIRST-TO-CHECK)) -
+ The STRING-INDEXth function argument is a format string of style
+ ARCHETYPE, which is one of:
+ printf, gnu_printf
+ scanf, gnu_scanf,
+ strftime, gnu_strftime,
+ strfmon,
+ or the same thing prefixed and suffixed with '__'.
+ If FIRST-TO-CHECK is not 0, arguments starting at FIRST-TO_CHECK
+ are suitable for the format string. */
+/* Applies to: functions. */
+#define ATTRIBUTE_FORMAT(spec) _GL_ATTRIBUTE_FORMAT (spec)
+
+/* ATTRIBUTE_NONNULL ((N1, N2,...)) - Arguments N1, N2,... must not be NULL.
+ ATTRIBUTE_NONNULL () - All pointer arguments must not be null. */
+/* Applies to: functions. */
+#define ATTRIBUTE_NONNULL(args) _GL_ATTRIBUTE_NONNULL (args)
+
+/* The function's return value is a non-NULL pointer. */
+/* Applies to: functions. */
+#define ATTRIBUTE_RETURNS_NONNULL _GL_ATTRIBUTE_RETURNS_NONNULL
+
+/* Warn if the caller does not use the return value,
+ unless the caller uses something like ignore_value. */
+/* Applies to: function, enumeration, class. */
+#define NODISCARD _GL_ATTRIBUTE_NODISCARD
+
+
+/* Attributes that disable false alarms when the compiler diagnoses
+ programmer "mistakes". */
+
+/* Do not warn if the entity is not used. */
+/* Applies to:
+ - function, variable,
+ - struct, union, struct/union member,
+ - enumeration, enumeration item,
+ - typedef,
+ in C++ also: class. */
+#define MAYBE_UNUSED _GL_ATTRIBUTE_MAYBE_UNUSED
+
+/* The contents of a character array is not meant to be NUL-terminated. */
+/* Applies to: struct/union members and variables that are arrays of element
+ type '[[un]signed] char'. */
+#define ATTRIBUTE_NONSTRING _GL_ATTRIBUTE_NONSTRING
+
+/* Do not warn if control flow falls through to the immediately
+ following 'case' or 'default' label. */
+/* Applies to: Empty statement (;), inside a 'switch' statement. */
+#define FALLTHROUGH _GL_ATTRIBUTE_FALLTHROUGH
+
+
+/* ================== Attributes for debugging information ==================
*/
+
+/* Attributes regarding debugging information emitted by the compiler. */
+
+/* Omit the function from stack traces when debugging. */
+/* Applies to: function. */
+#define ATTRIBUTE_ARTIFICIAL _GL_ATTRIBUTE_ARTIFICIAL
+
+/* Make the entity visible to debuggers etc., even with '-fwhole-program'. */
+/* Applies to: functions, variables. */
+#define ATTRIBUTE_EXTERNALLY_VISIBLE _GL_ATTRIBUTE_EXTERNALLY_VISIBLE
+
+
+/* ========== Attributes that mainly direct compiler optimizations ==========
*/
+
+/* The function does not throw exceptions. */
+/* Applies to: functions. */
+#define ATTRIBUTE_NOTHROW _GL_ATTRIBUTE_NOTHROW
+
+/* Do not inline the function. */
+/* Applies to: functions. */
+#define ATTRIBUTE_NOINLINE _GL_ATTRIBUTE_NOINLINE
+
+/* Always inline the function, and report an error if the compiler
+ cannot inline. */
+/* Applies to: function. */
+#define ATTRIBUTE_ALWAYS_INLINE _GL_ATTRIBUTE_ALWAYS_INLINE
+
+/* The function does not affect observable state, and always returns a value.
+ Compilers can omit duplicate calls with the same arguments if
+ observable state is not changed between calls. (This attribute is
+ looser than ATTRIBUTE_CONST.) */
+/* Applies to: functions. */
+#define ATTRIBUTE_PURE _GL_ATTRIBUTE_PURE
+
+/* The function neither depends on nor affects observable state,
+ and always returns a value. Compilers can omit duplicate calls with
+ the same arguments. (This attribute is stricter than ATTRIBUTE_PURE.) */
+/* Applies to: functions. */
+#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
+
+/* The function is rarely executed. */
+/* Applies to: functions. */
+#define ATTRIBUTE_COLD _GL_ATTRIBUTE_COLD
+
+/* If called from some other compilation unit, the function executes
+ code from that unit only by return or by exception handling,
+ letting the compiler optimize that unit more aggressively. */
+/* Applies to: functions. */
+#define ATTRIBUTE_LEAF _GL_ATTRIBUTE_LEAF
+
+/* For struct members: The member has the smallest possible alignment.
+ For struct, union, class: All members have the smallest possible alignment,
+ minimizing the memory required. */
+/* Applies to: struct members, struct, union,
+ in C++ also: class. */
+#define ATTRIBUTE_PACKED _GL_ATTRIBUTE_PACKED
+
+
+/* ================ Attributes that make invalid code valid ================ */
+
+/* Attributes that prevent fatal compiler optimizations for code that is not
+ fully ISO C compliant. */
+
+/* Pointers to the type may point to the same storage as pointers to
+ other types, thus disabling strict aliasing optimization. */
+/* Applies to: types. */
+#define ATTRIBUTE_MAY_ALIAS _GL_ATTRIBUTE_MAY_ALIAS
+
+
+#endif /* _GL_ATTRIBUTE_H */
diff --git a/lib/careadlinkat.c b/lib/careadlinkat.c
index 1effdb7..1aa0436 100644
--- a/lib/careadlinkat.c
+++ b/lib/careadlinkat.c
@@ -72,23 +72,38 @@ careadlinkat (int fd, char const *filename,
SSIZE_MAX < SIZE_MAX ? (size_t) SSIZE_MAX + 1 : SIZE_MAX;
char stack_buf[1024];
+#if (defined GCC_LINT || defined lint) && _GL_GNUC_PREREQ (10, 1)
+ /* Pacify preadlinkat without creating a pointer to the stack
+ that a broken gcc -Wreturn-local-addr would cry wolf about. See:
+ https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95044
+ This workaround differs from the mainline code, but
+ no other way to pacify GCC 10.1.0 is known; even an explicit
+ #pragma does not pacify GCC. When the GCC bug is fixed this
+ workaround should be limited to the broken GCC versions. */
+# define WORK_AROUND_GCC_BUG_95044
+#endif
+
if (! alloc)
alloc = &stdlib_allocator;
- if (! buffer_size)
+ if (!buffer)
{
+#ifdef WORK_AROUND_GCC_BUG_95044
+ buffer = alloc->allocate (sizeof stack_buf);
+#else
/* Allocate the initial buffer on the stack. This way, in the
common case of a symlink of small size, we get away with a
single small malloc() instead of a big malloc() followed by a
shrinking realloc(). */
buffer = stack_buf;
+#endif
buffer_size = sizeof stack_buf;
}
buf = buffer;
buf_size = buffer_size;
- do
+ while (buf)
{
/* Attempt to read the link into the current buffer. */
ssize_t link_length = preadlinkat (fd, filename, buf, buf_size);
@@ -117,19 +132,19 @@ careadlinkat (int fd, char const *filename,
if (buf == stack_buf)
{
- char *b = (char *) alloc->allocate (link_size);
+ char *b = alloc->allocate (link_size);
buf_size = link_size;
if (! b)
break;
- memcpy (b, buf, link_size);
- buf = b;
+ return memcpy (b, buf, link_size);
}
- else if (link_size < buf_size && buf != buffer && alloc->reallocate)
+
+ if (link_size < buf_size && buf != buffer && alloc->reallocate)
{
/* Shrink BUF before returning it. */
- char *b = (char *) alloc->reallocate (buf, link_size);
+ char *b = alloc->reallocate (buf, link_size);
if (b)
- buf = b;
+ return b;
}
return buf;
@@ -138,8 +153,8 @@ careadlinkat (int fd, char const *filename,
if (buf != buffer)
alloc->free (buf);
- if (buf_size <= buf_size_max / 2)
- buf_size *= 2;
+ if (buf_size < buf_size_max / 2)
+ buf_size = 2 * buf_size + 1;
else if (buf_size < buf_size_max)
buf_size = buf_size_max;
else if (buf_size_max < SIZE_MAX)
@@ -149,9 +164,8 @@ careadlinkat (int fd, char const *filename,
}
else
break;
- buf = (char *) alloc->allocate (buf_size);
+ buf = alloc->allocate (buf_size);
}
- while (buf);
if (alloc->die)
alloc->die (buf_size);
diff --git a/lib/dirent.in.h b/lib/dirent.in.h
index f7c2681..6fa44f0 100644
--- a/lib/dirent.in.h
+++ b/lib/dirent.in.h
@@ -57,10 +57,12 @@ typedef struct gl_directory DIR;
/* The __attribute__ feature is available in gcc versions 2.5 and later.
The attribute __pure__ was added in gcc 2.96. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
-# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
-#else
-# define _GL_ATTRIBUTE_PURE /* empty */
+#ifndef _GL_ATTRIBUTE_PURE
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+# else
+# define _GL_ATTRIBUTE_PURE /* empty */
+# endif
#endif
/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */
diff --git a/lib/explicit_bzero.c b/lib/explicit_bzero.c
index c82771f..b1f5acb 100644
--- a/lib/explicit_bzero.c
+++ b/lib/explicit_bzero.c
@@ -25,8 +25,18 @@
# include <config.h>
#endif
+/* memset_s need this define */
+#if HAVE_MEMSET_S
+# define __STDC_WANT_LIB_EXT1__ 1
+#endif
+
#include <string.h>
+#if defined _WIN32 && !defined __CYGWIN__
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+#endif
+
#if _LIBC
/* glibc-internal users use __explicit_bzero_chk, and explicit_bzero
redirects to that. */
@@ -38,8 +48,12 @@
void
explicit_bzero (void *s, size_t len)
{
-#ifdef HAVE_EXPLICIT_MEMSET
- explicit_memset (s, 0, len);
+#if defined _WIN32 && !defined __CYGWIN__
+ (void) SecureZeroMemory (s, len);
+#elif HAVE_EXPLICIT_MEMSET
+ explicit_memset (s, '\0', len);
+#elif HAVE_MEMSET_S
+ (void) memset_s (s, len, '\0', len);
#else
memset (s, '\0', len);
# if defined __GNUC__ && !defined __clang__
diff --git a/lib/gnulib.mk.in b/lib/gnulib.mk.in
index 0c7c2fb..5c11dfc 100644
--- a/lib/gnulib.mk.in
+++ b/lib/gnulib.mk.in
@@ -1122,6 +1122,7 @@ pdfdir = @pdfdir@
prefix = @prefix@
program_transform_name = @program_transform_name@
psdir = @psdir@
+runstatedir = @runstatedir@
sbindir = @sbindir@
sharedstatedir = @sharedstatedir@
srcdir = @srcdir@
@@ -1208,6 +1209,15 @@ endif
endif
## end gnulib module at-internal
+## begin gnulib module attribute
+ifeq (,$(OMIT_GNULIB_MODULE_attribute))
+
+
+EXTRA_DIST += attribute.h
+
+endif
+## end gnulib module attribute
+
## begin gnulib module binary-io
ifeq (,$(OMIT_GNULIB_MODULE_binary-io))
diff --git a/lib/ieee754.in.h b/lib/ieee754.in.h
index 01ca648..d64bb46 100644
--- a/lib/ieee754.in.h
+++ b/lib/ieee754.in.h
@@ -67,7 +67,7 @@ union ieee754_float
#endif /* Little endian. */
} ieee;
- /* This format makes it easier to see if a NaN is a signaling NaN. */
+ /* This format makes it easier to see if a NaN is a signalling NaN. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
@@ -118,7 +118,7 @@ union ieee754_double
#endif /* Little endian. */
} ieee;
- /* This format makes it easier to see if a NaN is a signaling NaN. */
+ /* This format makes it easier to see if a NaN is a signalling NaN. */
struct
{
#if __BYTE_ORDER == __BIG_ENDIAN
diff --git a/lib/limits.in.h b/lib/limits.in.h
index 90c273f..d25c523 100644
--- a/lib/limits.in.h
+++ b/lib/limits.in.h
@@ -15,16 +15,32 @@
You should have received a copy of the GNU General Public License
along with this program; if not, see <https://www.gnu.org/licenses/>. */
-#ifndef _@GUARD_PREFIX@_LIMITS_H
-
#if __GNUC__ >= 3
@PRAGMA_SYSTEM_HEADER@
#endif
@PRAGMA_COLUMNS@
-/* The include_next requires a split double-inclusion guard. */
+#if defined _GL_ALREADY_INCLUDING_LIMITS_H
+/* Special invocation convention:
+ On Haiku/x86_64, we have a sequence of nested includes
+ <limits.h> -> <syslimits.h> -> <limits.h>.
+ In this situation, LONG_MAX and INT_MAX are not yet defined,
+ therefore we should not attempt to define LONG_BIT. */
+
#@INCLUDE_NEXT@ @NEXT_LIMITS_H@
+#else
+/* Normal invocation convention. */
+
+#ifndef _@GUARD_PREFIX@_LIMITS_H
+
+# define _GL_ALREADY_INCLUDING_LIMITS_H
+
+/* The include_next requires a split double-inclusion guard. */
+# @INCLUDE_NEXT@ @NEXT_LIMITS_H@
+
+# undef _GL_ALREADY_INCLUDING_LIMITS_H
+
#ifndef _@GUARD_PREFIX@_LIMITS_H
#define _@GUARD_PREFIX@_LIMITS_H
@@ -102,3 +118,4 @@
#endif /* _@GUARD_PREFIX@_LIMITS_H */
#endif /* _@GUARD_PREFIX@_LIMITS_H */
+#endif
diff --git a/lib/nstrftime.c b/lib/nstrftime.c
index fc5052a..28b539d 100644
--- a/lib/nstrftime.c
+++ b/lib/nstrftime.c
@@ -68,16 +68,9 @@ extern char *tzname[];
#include <string.h>
#include <stdbool.h>
+#include "attribute.h"
#include <intprops.h>
-#ifndef FALLTHROUGH
-# if __GNUC__ < 7
-# define FALLTHROUGH ((void) 0)
-# else
-# define FALLTHROUGH __attribute__ ((__fallthrough__))
-# endif
-#endif
-
#ifdef COMPILE_WIDE
# include <endian.h>
# define CHAR_T wchar_t
diff --git a/lib/stdio.in.h b/lib/stdio.in.h
index 4a95f32..6c338dd 100644
--- a/lib/stdio.in.h
+++ b/lib/stdio.in.h
@@ -62,10 +62,12 @@
We enable _GL_ATTRIBUTE_FORMAT only if these are supported too, because
gnulib and libintl do '#define printf __printf__' when they override
the 'printf' function. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
-#else
-# define _GL_ATTRIBUTE_FORMAT(spec) /* empty */
+#ifndef _GL_ATTRIBUTE_FORMAT
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
+# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
+# else
+# define _GL_ATTRIBUTE_FORMAT(spec) /* empty */
+# endif
#endif
/* _GL_ATTRIBUTE_FORMAT_PRINTF
diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h
index ec5f124..59f9e6c 100644
--- a/lib/stdlib.in.h
+++ b/lib/stdlib.in.h
@@ -101,10 +101,12 @@ struct random_data
/* The __attribute__ feature is available in gcc versions 2.5 and later.
The attribute __pure__ was added in gcc 2.96. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
-# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
-#else
-# define _GL_ATTRIBUTE_PURE /* empty */
+#ifndef _GL_ATTRIBUTE_PURE
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+# else
+# define _GL_ATTRIBUTE_PURE /* empty */
+# endif
#endif
/* The definition of _Noreturn is copied here. */
diff --git a/lib/string.in.h b/lib/string.in.h
index 596c99b..a08e705 100644
--- a/lib/string.in.h
+++ b/lib/string.in.h
@@ -54,10 +54,12 @@
/* The __attribute__ feature is available in gcc versions 2.5 and later.
The attribute __pure__ was added in gcc 2.96. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
-# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
-#else
-# define _GL_ATTRIBUTE_PURE /* empty */
+#ifndef _GL_ATTRIBUTE_PURE
+# if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+# else
+# define _GL_ATTRIBUTE_PURE /* empty */
+# endif
#endif
/* NetBSD 5.0 declares strsignal in <unistd.h>, not in <string.h>. */
@@ -332,9 +334,10 @@ _GL_WARN_ON_USE (stpncpy, "stpncpy is unportable - "
GB18030 and the character to be searched is a digit. */
# undef strchr
/* Assume strchr is always declared. */
-_GL_WARN_ON_USE (strchr, "strchr cannot work correctly on character strings "
- "in some multibyte locales - "
- "use mbschr if you care about internationalization");
+_GL_WARN_ON_USE_CXX (strchr, const char *, (const char *, int),
+ "strchr cannot work correctly on character strings "
+ "in some multibyte locales - "
+ "use mbschr if you care about internationalization");
#endif
/* Find the first occurrence of C in S or the final NUL byte. */
@@ -526,15 +529,17 @@ _GL_CXXALIASWARN (strpbrk);
locale encoding is GB18030 and one of the characters to be searched is a
digit. */
# undef strpbrk
-_GL_WARN_ON_USE (strpbrk, "strpbrk cannot work correctly on character strings "
- "in multibyte locales - "
- "use mbspbrk if you care about internationalization");
+_GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *, const char *),
+ "strpbrk cannot work correctly on character strings "
+ "in multibyte locales - "
+ "use mbspbrk if you care about internationalization");
# endif
#elif defined GNULIB_POSIXCHECK
# undef strpbrk
# if HAVE_RAW_DECL_STRPBRK
-_GL_WARN_ON_USE (strpbrk, "strpbrk is unportable - "
- "use gnulib module strpbrk for portability");
+_GL_WARN_ON_USE_CXX (strpbrk, const char *, (const char *, const char *),
+ "strpbrk is unportable - "
+ "use gnulib module strpbrk for portability");
# endif
#endif
@@ -553,9 +558,10 @@ _GL_WARN_ON_USE (strspn, "strspn cannot work correctly on
character strings "
GB18030 and the character to be searched is a digit. */
# undef strrchr
/* Assume strrchr is always declared. */
-_GL_WARN_ON_USE (strrchr, "strrchr cannot work correctly on character strings "
- "in some multibyte locales - "
- "use mbsrchr if you care about internationalization");
+_GL_WARN_ON_USE_CXX (strrchr, const char *, (const char *, int),
+ "strrchr cannot work correctly on character strings "
+ "in some multibyte locales - "
+ "use mbsrchr if you care about internationalization");
#endif
/* Search the next delimiter (char listed in DELIM) starting at *STRINGP.
diff --git a/lib/warn-on-use.h b/lib/warn-on-use.h
index 1be2cbb..23c10fd 100644
--- a/lib/warn-on-use.h
+++ b/lib/warn-on-use.h
@@ -100,23 +100,28 @@ _GL_WARN_EXTERN_C int _gl_warn_on_use
#endif
/* _GL_WARN_ON_USE_CXX (function, rettype, parameters_and_attributes, "string")
- is like _GL_WARN_ON_USE (function, "string"), except that the function is
- declared with the given prototype, consisting of return type, parameters,
- and attributes.
+ is like _GL_WARN_ON_USE (function, "string"), except that in C++ mode the
+ function is declared with the given prototype, consisting of return type,
+ parameters, and attributes.
This variant is useful for overloaded functions in C++. _GL_WARN_ON_USE does
not work in this case. */
#ifndef _GL_WARN_ON_USE_CXX
-# if 4 < __GNUC__ || (__GNUC__ == 4 && 3 <= __GNUC_MINOR__)
+# if !defined __cplusplus
# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
+ _GL_WARN_ON_USE (function, msg)
+# else
+# if 4 < __GNUC__ || (__GNUC__ == 4 && 3 <= __GNUC_MINOR__)
+# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg)
\
extern rettype function parameters_and_attributes \
__attribute__ ((__warning__ (msg)))
-# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
+# elif __GNUC__ >= 3 && GNULIB_STRICT_CHECKING
/* Verify the existence of the function. */
-# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
+# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg)
\
extern rettype function parameters_and_attributes
-# else /* Unsupported. */
-# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg) \
+# else /* Unsupported. */
+# define _GL_WARN_ON_USE_CXX(function,rettype,parameters_and_attributes,msg)
\
_GL_WARN_EXTERN_C int _gl_warn_on_use
+# endif
# endif
#endif
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index 190b350..2d61a96 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -255,11 +255,7 @@ have been saved."
(if (abbrev--table-symbols table)
(insert-abbrev-table-description table nil)))
(when (unencodable-char-position (point-min) (point-max) 'utf-8)
- (setq coding-system-for-write
- (if (> emacs-major-version 24)
- 'utf-8-emacs
- ;; For compatibility with Emacs 22 (See Bug#8308)
- 'emacs-mule)))
+ (setq coding-system-for-write 'utf-8-emacs))
(goto-char (point-min))
(insert (format ";;-*-coding: %s;-*-\n" coding-system-for-write))
(write-region nil nil file nil (and (not verbose) 0)))))
diff --git a/lisp/apropos.el b/lisp/apropos.el
index e40f94c..7cbda3c 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -373,9 +373,11 @@ kind of objects to search."
(user-error "No word list given"))
pattern)))
-(defun apropos-parse-pattern (pattern)
+(defun apropos-parse-pattern (pattern &optional multiline-p)
"Rewrite a list of words to a regexp matching all permutations.
If PATTERN is a string, that means it is already a regexp.
+MULTILINE-P, if non-nil, means produce a regexp that will match
+the words even if separated by newlines.
This updates variables `apropos-pattern', `apropos-pattern-quoted',
`apropos-regexp', `apropos-words', and `apropos-all-words-regexp'."
(setq apropos-words nil
@@ -386,6 +388,9 @@ This updates variables `apropos-pattern',
`apropos-pattern-quoted',
;; any combination of two or more words like this:
;; (a|b|c).*(a|b|c) which may give some false matches,
;; but as long as it also gives the right ones, that's ok.
+ ;; (Actually, when MULTILINE-P is non-nil, instead of '.' we
+ ;; use a trick that would find a match even if the words are
+ ;; on different lines.
(let ((words pattern))
(setq apropos-pattern (mapconcat 'identity pattern " ")
apropos-pattern-quoted (regexp-quote apropos-pattern))
@@ -402,9 +407,13 @@ This updates variables `apropos-pattern',
`apropos-pattern-quoted',
(setq apropos-words (cons s apropos-words)
apropos-all-words (cons a apropos-all-words))))
(setq apropos-all-words-regexp
- (apropos-words-to-regexp apropos-all-words ".+"))
+ (apropos-words-to-regexp apropos-all-words
+ ;; The [^b-a] trick matches any
+ ;; character including a newline.
+ (if multiline-p "[^b-a]+?" ".+")))
(setq apropos-regexp
- (apropos-words-to-regexp apropos-words ".*?")))
+ (apropos-words-to-regexp apropos-words
+ (if multiline-p "[^b-a]*?" ".*?"))))
(setq apropos-pattern-quoted (regexp-quote pattern)
apropos-all-words-regexp pattern
apropos-pattern pattern
@@ -787,7 +796,7 @@ Returns list of symbols and values found."
(interactive (list (apropos-read-pattern "value")
current-prefix-arg))
(setq apropos--current (list #'apropos-value pattern do-all))
- (apropos-parse-pattern pattern)
+ (apropos-parse-pattern pattern t)
(or do-all (setq do-all apropos-do-all))
(setq apropos-accumulator ())
(let (f v p)
@@ -827,7 +836,7 @@ Optional arg BUFFER (default: current buffer) is the buffer
to check."
(interactive (list (apropos-read-pattern "value of buffer-local variable")))
(unless buffer (setq buffer (current-buffer)))
(setq apropos--current (list #'apropos-local-value pattern buffer))
- (apropos-parse-pattern pattern)
+ (apropos-parse-pattern pattern t)
(setq apropos-accumulator ())
(let ((var nil))
(mapatoms
@@ -869,7 +878,7 @@ Returns list of symbols and documentation found."
(interactive (list (apropos-read-pattern "documentation")
current-prefix-arg))
(setq apropos--current (list #'apropos-documentation pattern do-all))
- (apropos-parse-pattern pattern)
+ (apropos-parse-pattern pattern t)
(or do-all (setq do-all apropos-do-all))
(setq apropos-accumulator () apropos-files-scanned ())
(let ((standard-input (get-buffer-create " apropos-temp"))
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
index c918f06..6781c29 100644
--- a/lisp/arc-mode.el
+++ b/lisp/arc-mode.el
@@ -563,28 +563,8 @@ in which case a second argument, length LEN, should be
supplied."
(aref str (- len i)))))
result))
-(defun archive-int-to-mode (mode)
- "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------."
- ;; FIXME: merge with tar-grind-file-mode.
- (if (null mode)
- "??????????"
- (string
- (if (zerop (logand 8192 mode))
- (if (zerop (logand 16384 mode)) ?- ?d)
- ?c) ; completeness
- (if (zerop (logand 256 mode)) ?- ?r)
- (if (zerop (logand 128 mode)) ?- ?w)
- (if (zerop (logand 64 mode))
- (if (zerop (logand 2048 mode)) ?- ?S)
- (if (zerop (logand 2048 mode)) ?x ?s))
- (if (zerop (logand 32 mode)) ?- ?r)
- (if (zerop (logand 16 mode)) ?- ?w)
- (if (zerop (logand 8 mode))
- (if (zerop (logand 1024 mode)) ?- ?S)
- (if (zerop (logand 1024 mode)) ?x ?s))
- (if (zerop (logand 4 mode)) ?- ?r)
- (if (zerop (logand 2 mode)) ?- ?w)
- (if (zerop (logand 1 mode)) ?- ?x))))
+(define-obsolete-function-alias 'archive-int-to-mode
+ 'file-modes-number-to-symbolic "28.1")
(defun archive-calc-mode (oldmode newmode)
"From the integer OLDMODE and the string NEWMODE calculate a new file mode.
@@ -1526,7 +1506,7 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(timelen (length (archive--file-desc-time sample)))
(samplemode (and (archive--enabled-p 'Mode)
(archive--file-desc-mode sample)))
- (modelen (length (if samplemode (archive-int-to-mode samplemode)))))
+ (modelen (length (if samplemode (file-modes-number-to-symbolic
samplemode)))))
(dolist (desc descs)
(when ids
(let* ((uid (archive--file-desc-uid desc))
@@ -1573,7 +1553,7 @@ This doesn't recover lost files, it just undoes changes
in the buffer itself."
(text
(concat " "
(when (> modelen 0)
- (concat (archive-int-to-mode
+ (concat (file-modes-number-to-symbolic
(archive--file-desc-mode desc))
" "))
(when ids
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index 720ad18..5bb1698 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -734,8 +734,10 @@ CODING is the symbol of the coding-system in which the
file is encoded."
(if (memq (coding-system-base coding) '(undecided prefer-utf-8))
(setq coding 'utf-8-emacs))
(insert
- (format ";;;; Emacs Bookmark Format Version %d ;;;; -*- coding: %S -*-\n"
- bookmark-file-format-version (coding-system-base coding)))
+ (format
+ ";;;; Emacs Bookmark Format Version %d\
+;;;; -*- coding: %S; mode: lisp-data -*-\n"
+ bookmark-file-format-version (coding-system-base coding)))
(insert ";;; This format is meant to be slightly human-readable;\n"
";;; nevertheless, you probably don't want to edit it.\n"
";;; "
@@ -1721,7 +1723,7 @@ deletion, or > if it is flagged for displaying."
;; according to `bookmark-bookmarks-timestamp'.
(defun bookmark-bmenu-set-header ()
"Set the immutable header line."
- (let ((header (concat "%% " "Bookmark")))
+ (let ((header (copy-sequence "%% Bookmark")))
(when bookmark-bmenu-toggle-filenames
(setq header (concat header
(make-string (- bookmark-bmenu-file-column
diff --git a/lisp/button.el b/lisp/button.el
index b3afc4e..f969a03 100644
--- a/lisp/button.el
+++ b/lisp/button.el
@@ -349,7 +349,7 @@ Also see `insert-text-button'."
(or (plist-member properties 'type)
(plist-member properties :type))))
(when (stringp beg)
- (setq object beg beg 0 end (length object)))
+ (setq object (copy-sequence beg) beg 0 end (length object)))
;; Disallow setting the `category' property directly.
(when (plist-get properties 'category)
(error "Button `category' property may not be set directly"))
@@ -469,10 +469,12 @@ return t."
;; POS is a mouse event; switch to the proper window/buffer
(let ((posn (event-start pos)))
(with-current-buffer (window-buffer (posn-window posn))
- (if (posn-string posn)
- ;; mode-line, header-line, or display string event.
- (button-activate (posn-string posn) t)
- (push-button (posn-point posn) t))))
+ (let* ((str (posn-string posn))
+ (str-button (and str (get-text-property (cdr str) 'button
(car str)))))
+ (if str-button
+ ;; mode-line, header-line, or display string event.
+ (button-activate str t)
+ (push-button (posn-point posn) t)))))
;; POS is just normal position
(let ((button (button-at (or pos (point)))))
(when button
diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el
index d4562a0..c5d4d08 100644
--- a/lisp/calc/calc-comb.el
+++ b/lisp/calc/calc-comb.el
@@ -241,8 +241,8 @@
(calcFunc-gcd (math-neg a) b))
((Math-looks-negp b)
(calcFunc-gcd a (math-neg b)))
- ((Math-zerop a) b)
- ((Math-zerop b) a)
+ ((Math-zerop a) (math-abs b))
+ ((Math-zerop b) (math-abs a))
((and (Math-ratp a)
(Math-ratp b))
(math-make-frac (math-gcd (if (eq (car-safe a) 'frac) (nth 1 a) a)
diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el
index fe241b5..2850b33 100644
--- a/lisp/calc/calc-mtx.el
+++ b/lisp/calc/calc-mtx.el
@@ -275,7 +275,7 @@ in LUD decomposition."
k (1+ k)))
(setcar (nthcdr j (nth i lu)) sum)
(let ((dum (math-lud-pivot-check sum)))
- (if (Math-lessp big dum)
+ (if (or (math-zerop big) (Math-lessp big dum))
(setq big dum
imax i)))
(setq i (1+ i)))
diff --git a/lisp/calculator.el b/lisp/calculator.el
index 6996990..cd92f99 100644
--- a/lisp/calculator.el
+++ b/lisp/calculator.el
@@ -858,13 +858,11 @@ The result should not exceed the screen width."
"Convert the given STR to a number, according to the value of
`calculator-input-radix'."
(if calculator-input-radix
- (string-to-number str (cadr (assq calculator-input-radix
- '((bin 2) (oct 8) (hex 16)))))
- (let* ((str (replace-regexp-in-string
- "\\.\\([^0-9].*\\)?$" ".0\\1" str))
- (str (replace-regexp-in-string
- "[eE][+-]?\\([^0-9].*\\)?$" "e0\\1" str)))
- (string-to-number str))))
+ (string-to-number str (cadr (assq calculator-input-radix
+ '((bin 2) (oct 8) (hex 16)))))
+ ;; Allow entry of "1.e3".
+ (let ((str (replace-regexp-in-string (rx "." (any "eE")) "e" str)))
+ (float (string-to-number str)))))
(defun calculator-push-curnum ()
"Push the numeric value of the displayed number to the stack."
diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el
index b6bb040..4bfdf3a 100644
--- a/lisp/calendar/cal-bahai.el
+++ b/lisp/calendar/cal-bahai.el
@@ -57,8 +57,8 @@
(defconst calendar-bahai-month-name-array
["Bahá" "Jalál" "Jamál" "‘Aẓamat" "Núr" "Raḥmat" "Kalimát" "Kamál"
- "Asmá’" "‘Izzat" "Mashíyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il"
- "Sharaf" "Sulṭán" "Mulk" "‘Alá’"]
+ "Asmá’" "‘Izzat" "Mas͟híyyat" "‘Ilm" "Qudrat" "Qawl" "Masá’il"
+ "S͟haraf" "Sulṭán" "Mulk" "‘Alá’"]
"Array of the month names in the Bahá’í calendar.")
(defconst calendar-bahai-epoch (calendar-absolute-from-gregorian '(3 21 1844))
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
index 1c74131..918995d 100644
--- a/lisp/calendar/cal-julian.el
+++ b/lisp/calendar/cal-julian.el
@@ -1,4 +1,4 @@
-;;; cal-julian.el --- calendar functions for the Julian calendar
+;;; cal-julian.el --- calendar functions for the Julian calendar -*-
lexical-binding:t -*-
;; Copyright (C) 1995, 1997, 2001-2020 Free Software Foundation, Inc.
@@ -182,23 +182,27 @@ Echo astronomical (Julian) day number unless NOECHO is
non-nil."
(calendar-astro-to-absolute daynumber))))
(or noecho (calendar-astro-print-day-number)))
-
-;; The function below is designed to be used in sexp diary entries,
-;; and may be present in users' diary files, so suppress the warning
-;; about this prefix-less dynamic variable. It's called from
-;; `diary-list-sexp-entries', which binds the variable.
-(with-suppressed-warnings ((lexical date))
- (defvar date))
-
;;;###diary-autoload
(defun diary-julian-date ()
"Julian calendar equivalent of date diary entry."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(format "Julian date: %s" (calendar-julian-date-string date)))
;; To be called from diary-list-sexp-entries, where DATE is bound.
;;;###diary-autoload
(defun diary-astro-day-number ()
"Astronomical (Julian) day number diary entry."
+ ;; This function is designed to be used in sexp diary entries, and
+ ;; may be present in users' diary files, so suppress the warning
+ ;; about this prefix-less dynamic variable. It's called from
+ ;; `diary-list-sexp-entries', which binds the variable.
+ (with-suppressed-warnings ((lexical date))
+ (defvar date))
(format "Astronomical (Julian) day number at noon UTC: %s.0"
(calendar-astro-date-string date)))
diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el
index 075e122..604fc40 100644
--- a/lisp/cedet/data-debug.el
+++ b/lisp/cedet/data-debug.el
@@ -49,9 +49,9 @@
;;; Compatibility
;;
-(defalias 'data-debug-overlay-properties 'overlay-properties)
-(defalias 'data-debug-overlay-p 'overlayp)
-(defalias 'dd-propertize 'propertize)
+(define-obsolete-function-alias 'data-debug-overlay-properties
'overlay-properties "28.1")
+(define-obsolete-function-alias 'data-debug-overlay-p 'overlayp "28.1")
+(define-obsolete-function-alias 'dd-propertize 'propertize "28.1")
;;; GENERIC STUFF
;;
@@ -73,7 +73,7 @@ The attributes belong to the tag PARENT."
"Insert all the parts of OVERLAY.
PREFIX specifies what to insert at the start of each line."
(let ((attrprefix (concat (make-string (length prefix) ? ) "# "))
- (proplist (data-debug-overlay-properties overlay)))
+ (proplist (overlay-properties overlay)))
(data-debug-insert-property-list
proplist attrprefix)
)
@@ -393,10 +393,10 @@ PREBUTTONTEXT is some text between prefix and the stuff
list button."
(lambda (key value)
(data-debug-insert-thing
key prefix
- (dd-propertize "key " 'face font-lock-comment-face))
+ (propertize "key " 'face font-lock-comment-face))
(data-debug-insert-thing
value prefix
- (dd-propertize "val " 'face font-lock-comment-face)))
+ (propertize "val " 'face font-lock-comment-face)))
hash-table))
(defun data-debug-insert-hash-table-from-point (point)
@@ -415,9 +415,9 @@ PREBUTTONTEXT is some text between prefix and the stuff
list button."
(defun data-debug-insert-hash-table-button (hash-table prefix prebuttontext)
"Insert HASH-TABLE as expandable button with recursive prefix PREFIX and
PREBUTTONTEXT in front of the button text."
- (let ((string (dd-propertize (format "%s" hash-table)
+ (let ((string (propertize (format "%s" hash-table)
'face 'font-lock-keyword-face)))
- (insert (dd-propertize
+ (insert (propertize
(concat prefix prebuttontext string)
'ddebug hash-table
'ddebug-indent (length prefix)
@@ -444,7 +444,7 @@ PREBUTTONTEXT is some text between prefix and the stuff
list button."
(data-debug-insert-thing (car (cdr rest))
prefix
(concat
- (dd-propertize (format "%s" (car rest))
+ (propertize (format "%s" (car rest))
'face font-lock-comment-face)
" : "))
(setq rest (cdr (cdr rest))))
@@ -468,9 +468,9 @@ PREBUTTONTEXT is some text between prefix and the stuff
list button."
A Symbol is a simple thing, but this provides some face and prefix rules.
PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the thing."
- (let ((string (dd-propertize (format "#<WIDGET %s>" (car widget))
+ (let ((string (propertize (format "#<WIDGET %s>" (car widget))
'face 'font-lock-keyword-face)))
- (insert (dd-propertize
+ (insert (propertize
(concat prefix prebuttontext string)
'ddebug widget
'ddebug-indent (length prefix)
@@ -613,7 +613,7 @@ PREBUTTONTEXT is some text between prefix and the stuff
vector button."
(symbol-value symbol)
(concat (make-string indent ? ) "> ")
(concat
- (dd-propertize "value"
+ (propertize "value"
'face 'font-lock-comment-face)
" ")))
(data-debug-insert-property-list
@@ -628,13 +628,13 @@ PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the symbol button."
(let ((string
(cond ((fboundp symbol)
- (dd-propertize (concat "#'" (symbol-name symbol))
+ (propertize (concat "#'" (symbol-name symbol))
'face 'font-lock-function-name-face))
((boundp symbol)
- (dd-propertize (concat "'" (symbol-name symbol))
+ (propertize (concat "'" (symbol-name symbol))
'face 'font-lock-variable-name-face))
(t (format "'%s" symbol)))))
- (insert (dd-propertize
+ (insert (propertize
(concat prefix prebuttontext string)
'ddebug symbol
'ddebug-indent (length prefix)
@@ -657,7 +657,7 @@ PREBUTTONTEXT is some text between prefix and the thing."
(while (string-match "\t" newstr)
(setq newstr (replace-match "\\t" t t newstr)))
(insert prefix prebuttontext
- (dd-propertize (format "\"%s\"" newstr)
+ (propertize (format "\"%s\"" newstr)
'face font-lock-string-face)
"\n" )))
@@ -668,7 +668,7 @@ A Symbol is a simple thing, but this provides some face and
prefix rules.
PREFIX is the text that precedes the button.
PREBUTTONTEXT is some text between prefix and the thing."
(insert prefix prebuttontext
- (dd-propertize (format "%S" thing)
+ (propertize (format "%S" thing)
'face font-lock-string-face)
"\n"))
@@ -737,10 +737,10 @@ FACE is the face to use."
(null . data-debug-insert-nil)
;; Overlay
- (data-debug-overlay-p . data-debug-insert-overlay-button)
+ (overlayp . data-debug-insert-overlay-button)
;; Overlay list
- ((lambda (thing) (and (consp thing) (data-debug-overlay-p (car thing)))) .
+ ((lambda (thing) (and (consp thing) (overlayp (car thing)))) .
data-debug-insert-overlay-list-button)
;; Buffer
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 8c33611..4125281 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1515,8 +1515,11 @@ It does not apply the value to buffers."
(when project-dir
(ede-directory-get-open-project project-dir 'ROOT))))
-(cl-defmethod project-roots ((project ede-project))
- (list (ede-project-root-directory project)))
+(cl-defmethod project-root ((project ede-project))
+ (ede-project-root-directory project))
+
+;;; FIXME: Could someone look into implementing `project-ignores' for
+;;; EDE and/or a faster `project-files'?
(add-hook 'project-find-functions #'project-try-ede)
diff --git a/lisp/cedet/semantic/wisent/comp.el
b/lisp/cedet/semantic/wisent/comp.el
index 4e9927f..42c5756 100644
--- a/lisp/cedet/semantic/wisent/comp.el
+++ b/lisp/cedet/semantic/wisent/comp.el
@@ -3053,7 +3053,7 @@ one.")
(defsubst wisent-ISVALID-TOKEN (x)
"Return non-nil if X is a character or an allowed symbol."
- (or (wisent-char-p x)
+ (or (characterp x)
(wisent-ISVALID-VAR x)))
(defun wisent-push-token (symbol &optional nocheck)
@@ -3143,7 +3143,7 @@ the rule."
(cond
((or (memq item token-list) (memq item var-list)))
;; Create new literal character token
- ((wisent-char-p item) (wisent-push-token item t))
+ ((characterp item) (wisent-push-token item t))
((error "Symbol `%s' is used, but is not defined as a token and
has no rules"
item))))
(setq rhl (1+ rhl)
diff --git a/lisp/cedet/semantic/wisent/wisent.el
b/lisp/cedet/semantic/wisent/wisent.el
index d8a35d3..a0a8bed 100644
--- a/lisp/cedet/semantic/wisent/wisent.el
+++ b/lisp/cedet/semantic/wisent/wisent.el
@@ -55,11 +55,8 @@
;;;; Runtime stuff
;;;; -------------
-;;; Compatibility
-(eval-and-compile
- (if (fboundp 'char-valid-p)
- (defalias 'wisent-char-p 'char-valid-p)
- (defalias 'wisent-char-p 'char-or-char-int-p)))
+(define-obsolete-function-alias 'wisent-char-p
+ #'characterp "28.1")
;;; Printed representation of terminals and nonterminals
(defconst wisent-escape-sequence-strings
@@ -80,7 +77,7 @@
(defsubst wisent-item-to-string (item)
"Return a printed representation of ITEM.
ITEM can be a nonterminal or terminal symbol, or a character literal."
- (if (wisent-char-p item)
+ (if (characterp item)
(or (cdr (assq item wisent-escape-sequence-strings))
(format "'%c'" item))
(symbol-name item)))
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index d3d17fd..1ec2708 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -3824,7 +3824,17 @@ Optional EVENT is the location for the menu."
(defun custom-face-save (widget)
"Save the face edited by WIDGET."
- (custom-face-mark-to-save widget)
+ (let ((form (widget-get widget :custom-form)))
+ (if (memq form '(all lisp))
+ (custom-face-mark-to-save widget)
+ ;; The user is working on only a selected terminal type;
+ ;; make sure we save the entire spec to `custom-file'. (Bug #40866)
+ (custom-face-edit-all widget)
+ (custom-face-mark-to-save widget)
+ (if (eq form 'selected)
+ (custom-face-edit-selected widget)
+ ;; `form' is edit or mismatch; can't happen.
+ (widget-put widget :custom-form form))))
(custom-save-all)
(custom-face-state-set-and-redraw widget))
diff --git a/lisp/cus-start.el b/lisp/cus-start.el
index dff4d9a..6632687 100644
--- a/lisp/cus-start.el
+++ b/lisp/cus-start.el
@@ -771,9 +771,16 @@ since it could result in memory overflow and make Emacs
crash."
:safe (lambda (value) (or (booleanp value) (integerp value))))
(display-fill-column-indicator-character
display-fill-column-indicator
- character
+ (choice
+ (character :tag "Use U+2502 to indicate fill column"
+ :value ?│)
+ (character :tag "Use | to indicate fill column"
+ :value ?|)
+ (const :tag "If possible, use U+2502 to indicate fill column,
otherwise use |"
+ :value nil)
+ character)
"27.1"
- :safe characterp)
+ :safe (lambda (value) (or (characterp value) (null value))))
;; xfaces.c
(scalable-fonts-allowed display boolean "22.1")
;; xfns.c
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 9d117c6..7fe5f73 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -1017,13 +1017,16 @@ Frames with a non-nil `desktop-dont-save' parameter are
not saved."
;;;###autoload
(defun desktop-save (dirname &optional release only-if-changed version)
- "Save the desktop in a desktop file.
-Parameter DIRNAME specifies where to save the desktop file.
-Optional parameter RELEASE says whether we're done with this
-desktop. If ONLY-IF-CHANGED is non-nil, compare the current
-desktop information to that in the desktop file, and if the
-desktop information has not changed since it was last saved then
-do not rewrite the file.
+ "Save the state of Emacs in a desktop file in directory DIRNAME.
+Optional argument RELEASE non-nil says we're done with this
+desktop, in which case this function releases the lock of the
+desktop file in DIRNAME.
+If ONLY-IF-CHANGED is non-nil, compare the current desktop
+information to that in the desktop file, and if the desktop
+information has not changed since it was last saved, then do
+not rewrite the file.
+
+To restore the desktop, use `desktop-read'.
This function can save the desktop in either format version
208 (which only Emacs 25.1 and later can read) or version
@@ -1033,14 +1036,20 @@ it was last saved, or version 208 when writing a fresh
desktop
file.
To upgrade a version 206 file to version 208, call this command
-explicitly with a bare prefix argument: C-u M-x desktop-save.
-You are recommended to do this once you have firmly upgraded to
-Emacs 25.1 (or later). To downgrade a version 208 file to version
-206, use a double command prefix: C-u C-u M-x desktop-save.
-Confirmation will be requested in either case. In a non-interactive
-call, VERSION can be given as an integer, either 206 or 208, which
-will be accepted as the format version in which to save the file
-without further confirmation."
+explicitly with a prefix argument: \\[universal-argument] \\[desktop-save].
+If you are upgrading from Emacs 24 or older, we recommed to do
+this once you decide you no longer need compatibility with versions
+of Emacs before 25.1.
+
+To downgrade a version 208 file to version 206, use a double prefix
+argument: \\[universal-argument] \\[universal-argument] \\[desktop-save].
+
+Emacs will ask for confirmation when you upgrade or downgrade your
+desktop file.
+
+In a non-interactive call, VERSION can be given as an integer, either
+206 or 208, to specify the format version in which to save the file,
+no questions asked."
(interactive (list
;; Or should we just use (car desktop-path)?
(let ((default (if (member "." desktop-path)
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 60a352d..24ebfa4 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -2006,10 +2006,9 @@ Optional arg HOW-TO determines how to treat the target.
(format prompt (dired-mark-prompt arg files)) dir default))
(defun dired-dwim-target-directories ()
- (cond ((functionp dired-dwim-target)
- (funcall dired-dwim-target))
- (dired-dwim-target
- (dired-dwim-target-next))))
+ (if (functionp dired-dwim-target)
+ (funcall dired-dwim-target)
+ (dired-dwim-target-next)))
(defun dired-dwim-target-next (&optional all-frames)
;; Return directories from all next windows with dired-mode buffers.
diff --git a/lisp/dired.el b/lisp/dired.el
index 14bbb28..aad44a6 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -3717,8 +3717,8 @@ in the active region."
(defun dired-toggle-marks ()
"Toggle marks: marked files become unmarked, and vice versa.
-Files marked with other flags (such as `D') are not affected.
-`.' and `..' are never toggled.
+Flagged files (indicated with flags such as `C' and `D', not
+with `*') are not affected, and `.' and `..' are never toggled.
As always, hidden subdirs are not affected."
(interactive)
(save-excursion
diff --git a/lisp/display-fill-column-indicator.el
b/lisp/display-fill-column-indicator.el
index 25259aa..3f947bd 100644
--- a/lisp/display-fill-column-indicator.el
+++ b/lisp/display-fill-column-indicator.el
@@ -31,7 +31,7 @@
;; NOTE: Customization variables for
;; `display-fill-column-indicator-column' and
-;; `display-fill-column-indicator-char' itself are defined in
+;; `display-fill-column-indicator-character' itself are defined in
;; cus-start.el.
;;; Code:
@@ -39,7 +39,8 @@
(defgroup display-fill-column-indicator nil
"Display a fill column indicator in the buffer."
:group 'convenience
- :group 'display)
+ :group 'display
+ :link '(info-link "(emacs)Displaying Boundaries"))
;;;###autoload
@@ -49,7 +50,8 @@ This uses `display-fill-column-indicator' internally.
To change the position of the column displayed by default
customize `display-fill-column-indicator-column'. You can change the
-character for the indicator setting `display-fill-column-indicator-character'."
+character for the indicator setting `display-fill-column-indicator-character'.
+See Info node `Displaying Boundaries' for details."
:lighter nil
(if display-fill-column-indicator-mode
(progn
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 905659e..f47f4a2 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -87,13 +87,11 @@ and is the default except for MS-Windows."
(defun dnd-handle-one-url (window action url)
"Handle one dropped url by calling the appropriate handler.
The handler is first located by looking at `dnd-protocol-alist'.
-If no match is found here, and the value of `browse-url-browser-function'
-is a pair of (REGEXP . FUNCTION), those regexps are tried for a match.
-If no match is found, just call `dnd-insert-text'.
-WINDOW is where the drop happened, ACTION is the action for the drop,
-URL is what has been dropped.
-Returns ACTION."
- (require 'browse-url)
+If no match is found here, `browse-url-handlers' and
+`browse-url-default-handlers' are searched for a match.
+If no match is found, just call `dnd-insert-text'. WINDOW is
+where the drop happened, ACTION is the action for the drop, URL
+is what has been dropped. Returns ACTION."
(let (ret)
(or
(catch 'done
@@ -102,14 +100,16 @@ Returns ACTION."
(setq ret (funcall (cdr bf) url action))
(throw 'done t)))
nil)
- (when (not (functionp browse-url-browser-function))
- (catch 'done
- (dolist (bf browse-url-browser-function)
- (when (string-match (car bf) url)
- (setq ret 'private)
- (funcall (cdr bf) url action)
- (throw 'done t)))
- nil))
+ (catch 'done
+ ;; Autoloaded but the byte-compiler still complains.
+ (declare-function browse-url-select-handler "browse-url"
+ (url &optional kind))
+ (let ((browser (browse-url-select-handler url 'internal)))
+ (when browser
+ (setq ret 'private)
+ (funcall browser url action)
+ (throw 'done t)))
+ nil)
(progn
(dnd-insert-text window action url)
(setq ret 'private)))
diff --git a/lisp/doc-view.el b/lisp/doc-view.el
index 3cac262..de342f1 100644
--- a/lisp/doc-view.el
+++ b/lisp/doc-view.el
@@ -2050,8 +2050,8 @@ See the command `doc-view-mode' for more information on
this mode."
(when (memq (selected-frame) (alist-get 'frames attrs))
(let ((geom (alist-get 'geometry attrs)))
(when geom
- (setq monitor-top (nth 0 geom))
- (setq monitor-left (nth 1 geom))
+ (setq monitor-left (nth 0 geom))
+ (setq monitor-top (nth 1 geom))
(setq monitor-width (nth 2 geom))
(setq monitor-height (nth 3 geom))))))
(let ((frame (make-frame
diff --git a/lisp/dom.el b/lisp/dom.el
index 34df0e9..7ff9e07 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -67,6 +67,12 @@
(setcdr old value)
(setcar (cdr node) (nconc (cadr node) (list (cons attribute value)))))))
+(defun dom-remove-attribute (node attribute)
+ "Remove ATTRIBUTE from NODE."
+ (setq node (dom-ensure-node node))
+ (when-let ((old (assoc attribute (cadr node))))
+ (setcar (cdr node) (delq old (cadr node)))))
+
(defmacro dom-attr (node attr)
"Return the attribute ATTR from NODE.
A typical attribute is `href'."
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index b5d99e3..d168c25 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -632,7 +632,7 @@ If optional second arg SEP is a string, use that as
separator."
(bindat-format-vector vect "%d" (if (stringp sep) sep ".")))
(defun bindat-vector-to-hex (vect &optional sep)
- "Format vector VECT in hex format separated by dots.
+ "Format vector VECT in hex format separated by colons.
If optional second arg SEP is a string, use that as separator."
(bindat-format-vector vect "%02x" (if (stringp sep) sep ":")))
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 4f72251..62b82e4 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -1509,7 +1509,7 @@
byte-current-buffer byte-stack-ref))
(defconst byte-compile-side-effect-free-ops
- (nconc
+ (append
'(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index fa769ad..88e21b7 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -536,11 +536,12 @@ wrong number of parameters, say
(zot 1 2))
The warnings that can be suppressed are a subset of the warnings
-in `byte-compile-warning-types'; see this variable for a fuller
-explanation of the warning types. The types that can be
-suppressed with this macro are `free-vars', `callargs',
-`redefine', `obsolete', `interactive-only', `lexical', `mapcar',
-`constants' and `suspicious'.
+in `byte-compile-warning-types'; see the variable
+`byte-compile-warnings' for a fuller explanation of the warning
+types. The types that can be suppressed with this macro are
+`free-vars', `callargs', `redefine', `obsolete',
+`interactive-only', `lexical', `mapcar', `constants' and
+`suspicious'.
For the `mapcar' case, only the `mapcar' function can be used in
the symbol list. For `suspicious', only `set-buffer' can be used."
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 13b7219..72dbfd7 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -4752,6 +4752,14 @@ binding slots have been popped."
(defun byte-compile-form-make-variable-buffer-local (form)
(byte-compile-keep-pending form 'byte-compile-normal-call))
+;; Make `make-local-variable' declare the variable locally
+;; dynamic - this suppresses some unnecessary warnings
+(byte-defop-compiler-1 make-local-variable
+ byte-compile-make-local-variable)
+(defun byte-compile-make-local-variable (form)
+ (pcase form (`(,_ ',var) (byte-compile--declare-var var)))
+ (byte-compile-normal-call form))
+
(put 'function-put 'byte-hunk-handler 'byte-compile-define-symbol-prop)
(put 'define-symbol-prop 'byte-hunk-handler 'byte-compile-define-symbol-prop)
(defun byte-compile-define-symbol-prop (form)
diff --git a/lisp/emacs-lisp/check-declare.el b/lisp/emacs-lisp/check-declare.el
index 144385e..52cda95 100644
--- a/lisp/emacs-lisp/check-declare.el
+++ b/lisp/emacs-lisp/check-declare.el
@@ -1,4 +1,4 @@
-;;; check-declare.el --- Check declare-function statements
+;;; check-declare.el --- Check declare-function statements -*-
lexical-binding: t; -*-
;; Copyright (C) 2007-2020 Free Software Foundation, Inc.
@@ -248,7 +248,7 @@ TYPE is a string giving the nature of the error.
Optional LINE is the claim's line number; otherwise, search for the claim.
Display warning in `check-declare-warning-buffer'."
(let ((warning-prefix-function
- (lambda (level entry)
+ (lambda (_level entry)
(insert (format "%s:%d:" (file-relative-name file) (or line 0)))
entry))
(warning-fill-prefix " "))
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
index fd87159..66502da 100644
--- a/lisp/emacs-lisp/cl-indent.el
+++ b/lisp/emacs-lisp/cl-indent.el
@@ -46,14 +46,12 @@
"Maximum depth to backtrack out from a sublist for structured indentation.
If this variable is 0, no backtracking will occur and forms such as `flet'
may not be correctly indented."
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-tag-indentation 1
"Indentation of tags relative to containing list.
This variable is used by the function `lisp-indent-tagbody'."
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-tag-body-indentation 3
"Indentation of non-tagged lines relative to containing list.
@@ -64,32 +62,30 @@ the special form. If the value is t, the body of tags will
be indented
as a block at the same indentation as the first s-expression following
the tag. In this case, any forms before the first tag are indented
by `lisp-body-indent'."
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-backquote-indentation t
"Whether or not to indent backquoted lists as code.
If nil, indent backquoted lists as data, i.e., like quoted lists."
- :type 'boolean
- :group 'lisp-indent)
+ :type 'boolean)
-(defcustom lisp-loop-keyword-indentation 3
+(defcustom lisp-loop-keyword-indentation 6
"Indentation of loop keywords in extended loop forms."
:type 'integer
- :group 'lisp-indent)
+ :version "28.1")
-(defcustom lisp-loop-forms-indentation 5
+(defcustom lisp-loop-forms-indentation 6
"Indentation of forms in extended loop forms."
:type 'integer
- :group 'lisp-indent)
+ :version "28.1")
-(defcustom lisp-simple-loop-indentation 3
+(defcustom lisp-simple-loop-indentation 1
"Indentation of forms in simple loop forms."
:type 'integer
- :group 'lisp-indent)
+ :version "28.1")
(defcustom lisp-lambda-list-keyword-alignment nil
"Whether to vertically align lambda-list keywords together.
@@ -107,16 +103,14 @@ If non-nil, alignment is done with the first keyword
&key key1 key2)
#|...|#)"
:version "24.1"
- :type 'boolean
- :group 'lisp-indent)
+ :type 'boolean)
(defcustom lisp-lambda-list-keyword-parameter-indentation 2
"Indentation of lambda list keyword parameters.
See `lisp-lambda-list-keyword-parameter-alignment'
for more information."
:version "24.1"
- :type 'integer
- :group 'lisp-indent)
+ :type 'integer)
(defcustom lisp-lambda-list-keyword-parameter-alignment nil
"Whether to vertically align lambda-list keyword parameters together.
@@ -135,8 +129,7 @@ If non-nil, alignment is done with the first parameter
key3 key4)
#|...|#)"
:version "24.1"
- :type 'boolean
- :group 'lisp-indent)
+ :type 'boolean)
(defcustom lisp-indent-backquote-substitution-mode t
"How to indent substitutions in backquotes.
@@ -148,8 +141,7 @@ In any case, do not backtrack beyond a backquote
substitution.
Until Emacs 25.1, the nil behavior was hard-wired."
:version "25.1"
- :type '(choice (const corrected) (const nil) (const t))
- :group 'lisp-indent)
+ :type '(choice (const corrected) (const nil) (const t)))
(defvar lisp-indent-defun-method '(4 &lambda &body)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 4408bb5..3317c58 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1317,13 +1317,12 @@ For more details, see Info node `(cl)Loop Facility'.
((memq word '(across across-ref))
(let ((temp-vec (make-symbol "--cl-vec--"))
- (temp-len (make-symbol "--cl-len--"))
(temp-idx (make-symbol "--cl-idx--")))
(push (list temp-vec (pop cl--loop-args)) loop-for-bindings)
- (push (list temp-len `(length ,temp-vec)) loop-for-bindings)
(push (list temp-idx -1) loop-for-bindings)
+ (push `(setq ,temp-idx (1+ ,temp-idx)) cl--loop-body)
(cl--push-clause-loop-body
- `(< (setq ,temp-idx (1+ ,temp-idx)) ,temp-len))
+ `(< ,temp-idx (length ,temp-vec)))
(if (eq word 'across-ref)
(push (list var `(aref ,temp-vec ,temp-idx))
cl--loop-symbol-macs)
@@ -1337,7 +1336,6 @@ For more details, see Info node `(cl)Loop Facility'.
(error "Expected `of'"))))
(seq (cl--pop2 cl--loop-args))
(temp-seq (make-symbol "--cl-seq--"))
- (temp-len (make-symbol "--cl-len--"))
(temp-idx
(if (eq (car cl--loop-args) 'using)
(if (and (= (length (cadr cl--loop-args)) 2)
@@ -1348,19 +1346,16 @@ For more details, see Info node `(cl)Loop Facility'.
(push (list temp-seq seq) loop-for-bindings)
(push (list temp-idx 0) loop-for-bindings)
(if ref
- (progn
+ (let ((temp-len (make-symbol "--cl-len--")))
(push (list temp-len `(length ,temp-seq))
loop-for-bindings)
(push (list var `(elt ,temp-seq ,temp-idx))
cl--loop-symbol-macs)
- (cl--push-clause-loop-body `(< ,temp-idx ,temp-len)))
- ;; Evaluate seq length just if needed, that is, when seq
is not a cons.
- (push (list temp-len (or (consp seq) `(length ,temp-seq)))
- loop-for-bindings)
+ (cl--push-clause-loop-body `(< ,temp-idx ,temp-len)))
(push (list var nil) loop-for-bindings)
(cl--push-clause-loop-body `(and ,temp-seq
(or (consp ,temp-seq)
- (< ,temp-idx
,temp-len))))
+ (< ,temp-idx (length
,temp-seq)))))
(push (list var `(if (consp ,temp-seq)
(pop ,temp-seq)
(aref ,temp-seq ,temp-idx)))
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index a376067..7846118 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -741,6 +741,21 @@ Maybe clear the markers and delete the symbol's edebug
property?"
;;; Offsets for reader
+(defun edebug-get-edebug-or-ghost (name)
+ "Get NAME's value of property `edebug' or property `ghost-edebug'.
+
+The idea is that should function NAME be recompiled whilst
+debugging is in progress, property `edebug' will get set to a
+marker. The needed data will then come from property
+`ghost-edebug'."
+ (let ((e (get name 'edebug)))
+ (if (consp e)
+ e
+ (let ((g (get name 'ghost-edebug)))
+ (if (consp g)
+ g
+ e)))))
+
;; Define a structure to represent offset positions of expressions.
;; Each offset structure looks like: (before . after) for constituents,
;; or for structures that have elements: (before <subexpressions> . after)
@@ -1168,6 +1183,12 @@ purpose by adding an entry to this alist, and setting
;; Not edebugging this form, so reset the symbol's edebug
;; property to be just a marker at the definition's source
code.
;; This only works for defs with simple names.
+
+ ;; Preserve the `edebug' property in case there's
+ ;; debugging still under way.
+ (let ((ghost (get def-name 'edebug)))
+ (if (consp ghost)
+ (put def-name 'ghost-edebug ghost)))
(put def-name 'edebug (point-marker))
;; Also nil out dependent defs.
'(mapcar (function
@@ -1411,6 +1432,8 @@ contains a circular object."
(cons window (window-start window)))))
;; Store the edebug data in symbol's property list.
+ ;; We actually want to remove this property entirely, but can't.
+ (put edebug-def-name 'ghost-edebug nil)
(put edebug-def-name 'edebug
;; A struct or vector would be better here!!
(list edebug-form-begin-marker
@@ -1423,8 +1446,8 @@ contains a circular object."
)))
(defun edebug--restore-breakpoints (name)
- (let ((data (get name 'edebug)))
- (when (listp data)
+ (let ((data (edebug-get-edebug-or-ghost name)))
+ (when (consp data)
(let ((offsets (nth 2 data))
(breakpoints (nth 1 data))
(start (nth 0 data))
@@ -3128,7 +3151,7 @@ before returning. The default is one second."
;; Return (function . index) of the nearest edebug stop point.
(let* ((edebug-def-name (edebug-form-data-symbol))
(edebug-data
- (let ((data (get edebug-def-name 'edebug)))
+ (let ((data (edebug-get-edebug-or-ghost edebug-def-name)))
(if (or (null data) (markerp data))
(error "%s is not instrumented for Edebug" edebug-def-name))
data)) ; we could do it automatically, if data is a marker.
@@ -3165,7 +3188,7 @@ before returning. The default is one second."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
- (edebug-data (get edebug-def-name 'edebug))
+ (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
;; pull out parts of edebug-data
(edebug-def-mark (car edebug-data))
@@ -3206,7 +3229,7 @@ the breakpoint."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
- (edebug-data (get edebug-def-name 'edebug))
+ (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
;; pull out parts of edebug-data
(edebug-def-mark (car edebug-data))
@@ -3244,7 +3267,7 @@ the breakpoint."
"\x3c\x7e\xff\xff\xff\xff\x7e\x3c")
(defun edebug--overlay-breakpoints (function)
- (let* ((data (get function 'edebug))
+ (let* ((data (edebug-get-edebug-or-ghost function))
(start (nth 0 data))
(breakpoints (nth 1 data))
(offsets (nth 2 data)))
@@ -3284,9 +3307,9 @@ With prefix argument, make it a temporary breakpoint."
(interactive "P")
;; If the form hasn't been instrumented yet, do it now.
(when (and (not edebug-active)
- (let ((data (get (edebug--form-data-name
- (edebug-get-form-data-entry (point)))
- 'edebug)))
+ (let ((data (edebug-get-edebug-or-ghost
+ (edebug--form-data-name
+ (edebug-get-form-data-entry (point))))))
(or (null data) (markerp data))))
(edebug-defun))
(edebug-modify-breakpoint t nil arg))
@@ -3300,7 +3323,7 @@ With prefix argument, make it a temporary breakpoint."
"Unset all the breakpoints in the current form."
(interactive)
(let* ((name (edebug-form-data-symbol))
- (breakpoints (nth 1 (get name 'edebug))))
+ (breakpoints (nth 1 (edebug-get-edebug-or-ghost name))))
(unless breakpoints
(user-error "There are no breakpoints in %s" name))
(save-excursion
@@ -3316,7 +3339,7 @@ With prefix argument, make it a temporary breakpoint."
(user-error "No stop point near point"))
(let* ((name (car stop-point))
(index (cdr stop-point))
- (data (get name 'edebug))
+ (data (edebug-get-edebug-or-ghost name))
(breakpoint (assq index (nth 1 data))))
(unless breakpoint
(user-error "No breakpoint near point"))
@@ -3497,7 +3520,7 @@ instrument cannot be found, signal an error."
(goto-char func-marker)
(edebug-eval-top-level-form)
(list func)))
- ((consp func-marker)
+ ((and (consp func-marker) (consp (symbol-function func)))
(message "%s is already instrumented." func)
(list func))
(t
@@ -4270,7 +4293,7 @@ Save DEF-NAME, BEFORE-INDEX and AFTER-INDEX in FRAME."
(let* ((index (backtrace-get-index))
(frame (nth index backtrace-frames)))
(when (edebug--frame-def-name frame)
- (let* ((data (get (edebug--frame-def-name frame) 'edebug))
+ (let* ((data (edebug-get-edebug-or-ghost (edebug--frame-def-name frame)))
(marker (nth 0 data))
(offsets (nth 2 data)))
(pop-to-buffer (marker-buffer marker))
@@ -4354,7 +4377,7 @@ reinstrument it."
(let* ((function (edebug-form-data-symbol))
(counts (get function 'edebug-freq-count))
(coverages (get function 'edebug-coverage))
- (data (get function 'edebug))
+ (data (edebug-get-edebug-or-ghost function))
(def-mark (car data)) ; mark at def start
(edebug-points (nth 2 data))
(i (1- (length edebug-points)))
@@ -4512,7 +4535,7 @@ With prefix argument, make it a temporary breakpoint."
(if edebug-stop-point
(let* ((edebug-def-name (car edebug-stop-point))
(index (cdr edebug-stop-point))
- (edebug-data (get edebug-def-name 'edebug))
+ (edebug-data (edebug-get-edebug-or-ghost edebug-def-name))
(edebug-breakpoints (car (cdr edebug-data)))
(edebug-break-data (assq index edebug-breakpoints))
(edebug-break-condition (car (cdr edebug-break-data)))
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 9f8b639..ee5dd2c 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -351,24 +351,20 @@ Elements of FIELDS can be of the form (NAME PAT) in which
case the
contents of field NAME is matched against PAT, or they can be of
the form NAME which is a shorthand for (NAME NAME)."
(declare (debug (&rest [&or (sexp pcase-PAT) sexp])))
- (let ((is (make-symbol "table")))
- ;; FIXME: This generates a horrendous mess of redundant let bindings.
- ;; `pcase' needs to be improved somehow to introduce let-bindings more
- ;; sparingly, or the byte-compiler needs to be taught to optimize
- ;; them away.
- ;; FIXME: `pcase' does not do a good job here of sharing tests&code among
- ;; various branches.
- `(and (pred eieio-object-p)
- (app eieio-pcase-slot-index-table ,is)
- ,@(mapcar (lambda (field)
- (let* ((name (if (consp field) (car field) field))
- (pat (if (consp field) (cadr field) field))
- (i (make-symbol "index")))
- `(and (let (and ,i (pred natnump))
- (eieio-pcase-slot-index-from-index-table
- ,is ',name))
- (app (pcase--flip aref ,i) ,pat))))
- fields))))
+ ;; FIXME: This generates a horrendous mess of redundant let bindings.
+ ;; `pcase' needs to be improved somehow to introduce let-bindings more
+ ;; sparingly, or the byte-compiler needs to be taught to optimize
+ ;; them away.
+ ;; FIXME: `pcase' does not do a good job here of sharing tests&code among
+ ;; various branches.
+ `(and (pred eieio-object-p)
+ ,@(mapcar (lambda (field)
+ (pcase-exhaustive field
+ (`(,name ,pat)
+ `(app (pcase--flip eieio-oref ',name) ,pat))
+ ((pred symbolp)
+ `(app (pcase--flip eieio-oref ',field) ,field))))
+ fields)))
;;; Simple generators, and query functions. None of these would do
;; well embedded into an object.
@@ -517,7 +513,8 @@ The CLOS function `class-direct-subclasses' is aliased to
this function."
"Set the value in OBJ for slot SLOT to VALUE.
SLOT is the slot name as specified in `defclass' or the tag created
with in the :initarg slot. VALUE can be any Lisp object."
- (declare (debug (form symbolp form)))
+ (declare (obsolete "use (setf (oref ..) ..) instead" "28.1")
+ (debug (form symbolp form)))
`(eieio-oset ,obj (quote ,slot) ,value))
(defmacro oset-default (class slot value)
@@ -525,7 +522,8 @@ with in the :initarg slot. VALUE can be any Lisp object."
The default value is usually set with the :initform tag during class
creation. This allows users to change the default behavior of classes
after they are created."
- (declare (debug (form symbolp form)))
+ (declare (obsolete "use (setf (oref-default ..) ..) instead" "28.1")
+ (debug (form symbolp form)))
`(eieio-oset-default ,class (quote ,slot) ,value))
;;; CLOS queries into classes and slots
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 4a2e748..ef5dbf8 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -5,6 +5,11 @@
;; Author: Noah Friedman <friedman@splode.com>
;; Keywords: extensions
;; Created: 1995-10-06
+;; Version: 1.0.0
+;; Package-Requires: ((emacs "26.3"))
+
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el
index 50b157b..d92ca5b 100644
--- a/lisp/emacs-lisp/float-sup.el
+++ b/lisp/emacs-lisp/float-sup.el
@@ -1,4 +1,4 @@
-;;; float-sup.el --- define some constants useful for floating point numbers.
+;;; float-sup.el --- define some constants useful for floating point numbers.
-*- lexical-binding:t -*-
;; Copyright (C) 1985-1987, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 98c4416..7098a41 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -611,6 +611,8 @@ Value for `adaptive-fill-function'."
;; a single docstring. Let's fix it here.
(if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") ""))
+;; Maybe this should be discouraged/obsoleted and users should be
+;; encouraged to use `lisp-data-mode` instead.
(defun lisp-mode-variables (&optional lisp-syntax keywords-case-insensitive
elisp)
"Common initialization routine for lisp modes.
@@ -658,6 +660,14 @@ font-lock keywords will not be case sensitive."
(setq-local electric-pair-skip-whitespace 'chomp)
(setq-local electric-pair-open-newline-between-pairs nil))
+;;;###autoload
+(define-derived-mode lisp-data-mode prog-mode "Lisp-Data"
+ "Major mode for buffers holding data written in Lisp syntax."
+ :group 'lisp
+ (lisp-mode-variables t t nil)
+ (setq-local electric-quote-string t)
+ (setq imenu-case-fold-search nil))
+
(defun lisp-outline-level ()
"Lisp mode `outline-level' function."
(let ((len (- (match-end 0) (match-beginning 0))))
@@ -737,7 +747,7 @@ font-lock keywords will not be case sensitive."
"Keymap for ordinary Lisp mode.
All commands in `lisp-mode-shared-map' are inherited by this map.")
-(define-derived-mode lisp-mode prog-mode "Lisp"
+(define-derived-mode lisp-mode lisp-data-mode "Lisp"
"Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
Commands:
Delete converts tabs to spaces as it moves back.
@@ -746,7 +756,6 @@ Blank lines separate paragraphs. Semicolons start comments.
\\{lisp-mode-map}
Note that `run-lisp' may be used either to start an inferior Lisp job
or to switch back to an existing one."
- (lisp-mode-variables nil t)
(setq-local lisp-indent-function 'common-lisp-indent-function)
(setq-local find-tag-default-function 'lisp-find-tag-default)
(setq-local comment-start-skip
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 4312ab9..9a6d1d7 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -397,6 +397,26 @@ synchronously."
:type 'boolean
:version "25.1")
+(defcustom package-name-column-width 30
+ "Column width for the Package name in the package menu."
+ :type 'number
+ :version "28.1")
+
+(defcustom package-version-column-width 14
+ "Column width for the Package version in the package menu."
+ :type 'number
+ :version "28.1")
+
+(defcustom package-status-column-width 12
+ "Column width for the Package status in the package menu."
+ :type 'number
+ :version "28.1")
+
+(defcustom package-archive-column-width 8
+ "Column width for the Package status in the package menu."
+ :type 'number
+ :version "28.1")
+
;;; `package-desc' object definition
;; This is the struct used internally to represent packages.
@@ -2692,6 +2712,7 @@ either a full name or nil, and EMAIL is a valid email
address."
(define-key map (kbd "/ n") 'package-menu-filter-by-name)
(define-key map (kbd "/ s") 'package-menu-filter-by-status)
(define-key map (kbd "/ v") 'package-menu-filter-by-version)
+ (define-key map (kbd "/ m") 'package-menu-filter-marked)
map)
"Local keymap for `package-menu-mode' buffers.")
@@ -2722,6 +2743,7 @@ either a full name or nil, and EMAIL is a valid email
address."
["Filter by Name" package-menu-filter-by-name :help "Filter packages by
name"]
["Filter by Status" package-menu-filter-by-status :help "Filter packages
by status"]
["Filter by Version" package-menu-filter-by-version :help "Filter
packages by version"]
+ ["Filter Marked" package-menu-filter-marked :help "Filter packages marked
for upgrade"]
["Clear Filter" package-menu-clear-filter :help "Clear package list
filter"])
["Hide by Regexp" package-menu-hide-package :help "Hide all packages
matching a regexp"]
@@ -2748,11 +2770,11 @@ Letters do not insert themselves; instead, they are
commands.
(package-menu--transaction-status
package-menu--transaction-status)))
(setq tabulated-list-format
- `[("Package" 18 package-menu--name-predicate)
- ("Version" 13 package-menu--version-predicate)
- ("Status" 10 package-menu--status-predicate)
+ `[("Package" ,package-name-column-width package-menu--name-predicate)
+ ("Version" ,package-version-column-width
package-menu--version-predicate)
+ ("Status" ,package-status-column-width
package-menu--status-predicate)
,@(if (cdr package-archives)
- '(("Archive" 10 package-menu--archive-predicate)))
+ `(("Archive" ,package-archive-column-width
package-menu--archive-predicate)))
("Description" 0 package-menu--description-predicate)])
(setq tabulated-list-padding 2)
(setq tabulated-list-sort-key (cons "Status" nil))
@@ -3855,6 +3877,35 @@ If VERSION is nil or the empty string, show all
packages."
(funcall fun (package-desc-version pkg-desc) ver)))
(format "versions:%s%s" predicate version)))))
+(defun package-menu-filter-marked ()
+ "Filter \"*Packages*\" buffer by non-empty upgrade mark.
+Unlike other filters, this leaves the marks intact."
+ (interactive)
+ (package--ensure-package-menu-mode)
+ (widen)
+ (let (found-entries mark pkg-id entry marks)
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq mark (char-after))
+ (unless (eq mark ?\s)
+ (setq pkg-id (tabulated-list-get-id))
+ (setq entry (package-menu--print-info-simple pkg-id))
+ (push entry found-entries)
+ ;; remember the mark
+ (push (cons pkg-id mark) marks))
+ (forward-line))
+ (if found-entries
+ (progn
+ (setq tabulated-list-entries found-entries)
+ (package-menu--display t nil)
+ ;; redo the marks, but we must remember the marks!!
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq mark (cdr (assq (tabulated-list-get-id) marks)))
+ (tabulated-list-put-tag (char-to-string mark) t)))
+ (user-error "No packages found")))))
+
(defun package-menu-clear-filter ()
"Clear any filter currently applied to the \"*Packages*\" buffer."
(interactive)
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 36b93fa..a8ce232 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -344,7 +344,8 @@ of the elements of LIST is performed as if by `pcase-let'.
(seen '())
(codegen
(lambda (code vars)
- (let ((prev (assq code seen)))
+ (let ((vars (pcase--fgrep vars code))
+ (prev (assq code seen)))
(if (not prev)
(let ((res (pcase-codegen code vars)))
(push (list code vars res) seen)
@@ -398,7 +399,10 @@ of the elements of LIST is performed as if by `pcase-let'.
(if (pcase--small-branch-p (cdr case))
;; Don't bother sharing multiple
;; occurrences of this leaf since it's small.
- #'pcase-codegen codegen)
+ (lambda (code vars)
+ (pcase-codegen code
+ (pcase--fgrep vars code)))
+ codegen)
(cdr case)
vars))))
cases))))
@@ -687,14 +691,22 @@ MATCH is the pattern that needs to be matched, of the
form:
'(nil . :pcase--fail)
'(:pcase--fail . nil))))))
-(defun pcase--fgrep (vars sexp)
- "Check which of the symbols VARS appear in SEXP."
+(defun pcase--fgrep (bindings sexp)
+ "Return those of the BINDINGS which might be used in SEXP."
(let ((res '()))
- (while (consp sexp)
- (dolist (var (pcase--fgrep vars (pop sexp)))
- (unless (memq var res) (push var res))))
- (and (memq sexp vars) (not (memq sexp res)) (push sexp res))
- res))
+ (while (and (consp sexp) bindings)
+ (dolist (binding (pcase--fgrep bindings (pop sexp)))
+ (push binding res)
+ (setq bindings (remove binding bindings))))
+ (if (vectorp sexp)
+ ;; With backquote, code can appear within vectors as well.
+ ;; This wouldn't be needed if we `macroexpand-all' before
+ ;; calling pcase--fgrep, OTOH.
+ (pcase--fgrep bindings (mapcar #'identity sexp))
+ (let ((tmp (assq sexp bindings)))
+ (if tmp
+ (cons tmp res)
+ res)))))
(defun pcase--self-quoting-p (upat)
(or (keywordp upat) (integerp upat) (stringp upat)))
@@ -734,13 +746,11 @@ MATCH is the pattern that needs to be matched, of the
form:
"Build a function call to FUN with arg ARG."
(if (symbolp fun)
`(,fun ,arg)
- (let* (;; `vs' is an upper bound on the vars we need.
- (vs (pcase--fgrep (mapcar #'car vars) fun))
- (env (mapcar (lambda (var)
- (list var (cdr (assq var vars))))
- vs))
+ (let* (;; `env' is an upper bound on the bindings we need.
+ (env (mapcar (lambda (x) (list (car x) (cdr x)))
+ (pcase--fgrep vars fun)))
(call (progn
- (when (memq arg vs)
+ (when (assq arg env)
;; `arg' is shadowed by `env'.
(let ((newsym (gensym "x")))
(push (list newsym arg) env)
@@ -748,7 +758,7 @@ MATCH is the pattern that needs to be matched, of the form:
(if (functionp fun)
`(funcall #',fun ,arg)
`(,@fun ,arg)))))
- (if (null vs)
+ (if (null env)
call
;; Let's not replace `vars' in `fun' since it's
;; too difficult to do it right, instead just
@@ -759,10 +769,12 @@ MATCH is the pattern that needs to be matched, of the
form:
"Build an expression that will evaluate EXP."
(let* ((found (assq exp vars)))
(if found (cdr found)
- (let* ((vs (pcase--fgrep (mapcar #'car vars) exp))
- (env (mapcar (lambda (v) (list v (cdr (assq v vars))))
- vs)))
- (if env (macroexp-let* env exp) exp)))))
+ (let* ((env (pcase--fgrep vars exp)))
+ (if env
+ (macroexp-let* (mapcar (lambda (x) (list (car x) (cdr x)))
+ env)
+ exp)
+ exp)))))
;; It's very tempting to use `pcase' below, tho obviously, it'd create
;; bootstrapping problems.
diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el
index 11cc198..ce495af 100644
--- a/lisp/emacs-lisp/syntax.el
+++ b/lisp/emacs-lisp/syntax.el
@@ -63,9 +63,10 @@ override the buffer's syntax table for special syntactic
constructs that
cannot be handled just by the buffer's syntax-table.
The specified function may call `syntax-ppss' on any position
-before END, but it should not call `syntax-ppss-flush-cache',
-which means that it should not call `syntax-ppss' on some
-position and later modify the buffer on some earlier position.")
+before END, but if it calls `syntax-ppss' on some
+position and later modifies the buffer on some earlier position,
+then it is its responsability to call `syntax-ppss-flush-cache' to flush
+the now obsolete ppss info from the cache.")
(defvar syntax-propertize-chunk-size 500)
@@ -138,14 +139,28 @@ delimiter or an Escaped or Char-quoted character."))
(point-max))))
(cons beg end))
-(defun syntax-propertize--shift-groups (re n)
- (replace-regexp-in-string
- "\\\\(\\?\\([0-9]+\\):"
- (lambda (s)
- (replace-match
- (number-to-string (+ n (string-to-number (match-string 1 s))))
- t t s 1))
- re t t))
+(defun syntax-propertize--shift-groups-and-backrefs (re n)
+ (let ((new-re (replace-regexp-in-string
+ "\\\\(\\?\\([0-9]+\\):"
+ (lambda (s)
+ (replace-match
+ (number-to-string
+ (+ n (string-to-number (match-string 1 s))))
+ t t s 1))
+ re t t))
+ (pos 0))
+ (while (string-match "\\\\\\([0-9]+\\)" new-re pos)
+ (setq pos (+ 1 (match-beginning 1)))
+ (when (save-match-data
+ ;; With \N, the \ must be in a subregexp context, i.e.,
+ ;; not in a character class or in a \{\} repetition.
+ (subregexp-context-p new-re (match-beginning 0)))
+ (let ((shifted (+ n (string-to-number (match-string 1 new-re)))))
+ (when (> shifted 9)
+ (error "There may be at most nine back-references"))
+ (setq new-re (replace-match (number-to-string shifted)
+ t t new-re 1)))))
+ new-re))
(defmacro syntax-propertize-precompile-rules (&rest rules)
"Return a precompiled form of RULES to pass to `syntax-propertize-rules'.
@@ -189,7 +204,8 @@ for subsequent HIGHLIGHTs.
Also SYNTAX is free to move point, in which case RULES may not be applied to
some parts of the text or may be applied several times to other parts.
-Note: back-references in REGEXPs do not work."
+Note: There may be at most nine back-references in the REGEXPs of
+all RULES in total."
(declare (debug (&rest &or symbolp ;FIXME: edebug this eval step.
(form &rest
(numberp
@@ -218,7 +234,7 @@ Note: back-references in REGEXPs do not work."
;; tell when *this* match 0 has succeeded.
(cl-incf offset)
(setq re (concat "\\(" re "\\)")))
- (setq re (syntax-propertize--shift-groups re offset))
+ (setq re (syntax-propertize--shift-groups-and-backrefs re
offset))
(let ((code '())
(condition
(cond
@@ -320,6 +336,11 @@ END) suitable for `syntax-propertize-function'."
(defvar-local syntax-ppss-table nil
"Syntax-table to use during `syntax-ppss', if any.")
+(defvar-local syntax-propertize--inhibit-flush nil
+ "If non-nil, `syntax-ppss-flush-cache' only flushes the ppss cache.
+Otherwise it flushes both the ppss cache and the properties
+set by `syntax-propertize'")
+
(defun syntax-propertize (pos)
"Ensure that syntax-table properties are set until POS (a buffer point)."
(when (< syntax-propertize--done pos)
@@ -345,23 +366,27 @@ END) suitable for `syntax-propertize-function'."
(end (max pos
(min (point-max)
(+ start syntax-propertize-chunk-size))))
- (funs syntax-propertize-extend-region-functions))
- (while funs
- (let ((new (funcall (pop funs) start end))
- ;; Avoid recursion!
- (syntax-propertize--done most-positive-fixnum))
- (if (or (null new)
- (and (>= (car new) start) (<= (cdr new) end)))
- nil
- (setq start (car new))
- (setq end (cdr new))
- ;; If there's been a change, we should go through the
- ;; list again since this new position may
- ;; warrant a different answer from one of the funs we've
- ;; already seen.
- (unless (eq funs
- (cdr
syntax-propertize-extend-region-functions))
- (setq funs syntax-propertize-extend-region-functions)))))
+ (first t)
+ (repeat t))
+ (while repeat
+ (setq repeat nil)
+ (run-hook-wrapped
+ 'syntax-propertize-extend-region-functions
+ (lambda (f)
+ (let ((new (funcall f start end))
+ ;; Avoid recursion!
+ (syntax-propertize--done most-positive-fixnum))
+ (if (or (null new)
+ (and (>= (car new) start) (<= (cdr new) end)))
+ nil
+ (setq start (car new))
+ (setq end (cdr new))
+ ;; If there's been a change, we should go through the
+ ;; list again since this new position may
+ ;; warrant a different answer from one of the funs we've
+ ;; already seen.
+ (unless first (setq repeat t))))
+ (setq first nil))))
;; Flush ppss cache between the original value of `start' and
that
;; set above by syntax-propertize-extend-region-functions.
(syntax-ppss-flush-cache start)
@@ -371,8 +396,13 @@ END) suitable for `syntax-propertize-function'."
;; (message "syntax-propertizing from %s to %s" start end)
(remove-text-properties start end
'(syntax-table nil syntax-multiline nil))
- ;; Avoid recursion!
- (let ((syntax-propertize--done most-positive-fixnum))
+ ;; Make sure we only let-bind it buffer-locally.
+ (make-local-variable 'syntax-propertize--inhibit-flush)
+ ;; Let-bind `syntax-propertize--done' to avoid infinite
recursion!
+ (let ((syntax-propertize--done most-positive-fixnum)
+ ;; Let `syntax-propertize-function' call
+ ;; `syntax-ppss-flush-cache' without worries.
+ (syntax-propertize--inhibit-flush t))
(funcall syntax-propertize-function start end)))))))))
;;; Link syntax-propertize with syntax.c.
@@ -451,7 +481,8 @@ These are valid when the buffer has no restriction.")
(defun syntax-ppss-flush-cache (beg &rest ignored)
"Flush the cache of `syntax-ppss' starting at position BEG."
;; Set syntax-propertize to refontify anything past beg.
- (setq syntax-propertize--done (min beg syntax-propertize--done))
+ (unless syntax-propertize--inhibit-flush
+ (setq syntax-propertize--done (min beg syntax-propertize--done)))
;; Flush invalid cache entries.
(dolist (cell (list syntax-ppss-wide syntax-ppss-narrow))
(pcase cell
diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el
index 4cebd73..00d0969 100644
--- a/lisp/emacs-lisp/timer-list.el
+++ b/lisp/emacs-lisp/timer-list.el
@@ -32,41 +32,49 @@
"List all timers in a buffer."
(interactive)
(pop-to-buffer-same-window (get-buffer-create "*timer-list*"))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (timer-list-mode)
- (dolist (timer (append timer-list timer-idle-list))
- (insert (format "%4s %10s %8s %s"
- ;; Idle.
- (if (aref timer 7) "*" " ")
- ;; Next time.
- (let ((time (list (aref timer 1)
- (aref timer 2)
- (aref timer 3))))
- (format "%.2f"
- (float-time
- (if (aref timer 7)
- time
- (time-subtract time nil)))))
- ;; Repeat.
- (let ((repeat (aref timer 4)))
- (cond
- ((numberp repeat)
- (format "%.1f" repeat))
- ((null repeat)
- "-")
- (t
- (format "%s" repeat))))
- ;; Function.
- (let ((cl-print-compiled 'static)
- (cl-print-compiled-button nil)
- (print-escape-newlines t))
- (cl-prin1-to-string (aref timer 5)))))
- (put-text-property (line-beginning-position)
- (1+ (line-beginning-position))
- 'timer timer)
- (insert "\n")))
- (goto-char (point-min)))
+ (timer-list-mode)
+ (tabulated-list-init-header)
+ (setq tabulated-list-entries
+ (mapcar
+ (lambda (timer)
+ (list
+ nil
+ `[ ;; Idle.
+ ,(propertize
+ (if (aref timer 7) " *" " ")
+ 'help-echo "* marks idle timers"
+ 'timer timer)
+ ;; Next time.
+ ,(propertize
+ (let ((time (list (aref timer 1)
+ (aref timer 2)
+ (aref timer 3))))
+ (format "%10.2f"
+ (float-time
+ (if (aref timer 7)
+ time
+ (time-subtract time nil)))))
+ 'help-echo "Time in sec till next invocation")
+ ;; Repeat.
+ ,(propertize
+ (let ((repeat (aref timer 4)))
+ (cond
+ ((numberp repeat)
+ (format "%8.1f" repeat))
+ ((null repeat)
+ " -")
+ (t
+ (format "%8s" repeat))))
+ 'help-echo "Symbol: repeat; number: repeat interval in sec")
+ ;; Function.
+ ,(propertize
+ (let ((cl-print-compiled 'static)
+ (cl-print-compiled-button nil)
+ (print-escape-newlines t))
+ (cl-prin1-to-string (aref timer 5)))
+ 'help-echo "Function called by timer")]))
+ (append timer-list timer-idle-list)))
+ (tabulated-list-print))
;; This command can be destructive if they don't know what they are
;; doing. Kids, don't try this at home!
;;;###autoload (put 'list-timers 'disabled "Beware: manually canceling timers
can ruin your Emacs session.")
@@ -74,35 +82,47 @@
(defvar timer-list-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "c" 'timer-list-cancel)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
(easy-menu-define nil map ""
'("Timers"
["Cancel" timer-list-cancel t]))
map))
-(define-derived-mode timer-list-mode special-mode "Timer-List"
+(define-derived-mode timer-list-mode tabulated-list-mode "Timer-List"
"Mode for listing and controlling timers."
- (setq bidi-paragraph-direction 'left-to-right)
- (setq truncate-lines t)
(buffer-disable-undo)
(setq-local revert-buffer-function #'list-timers)
- (setq buffer-read-only t)
- (setq header-line-format
- (concat (propertize " " 'display '(space :align-to 0))
- (format "%4s %10s %8s %s"
- (propertize "Idle"
- 'mouse-face 'highlight
- 'help-echo "* marks idle timers")
- (propertize "Next"
- 'mouse-face 'highlight
- 'help-echo "Time in sec till next
invocation")
- (propertize "Repeat"
- 'mouse-face 'highlight
- 'help-echo "Symbol: repeat; number: repeat
interval in sec")
- (propertize "Function"
- 'mouse-face 'highlight
- 'help-echo "Function called by timer")))))
+ (setq tabulated-list-format
+ '[("Idle" 6 timer-list--idle-predicate)
+ (" Next" 12 timer-list--next-predicate)
+ (" Repeat" 11 timer-list--repeat-predicate)
+ ("Function" 10 timer-list--function-predicate)]))
+
+(defun timer-list--idle-predicate (A B)
+ "Predicate to sort Timer-List by the Idle column."
+ (let ((iA (aref (cadr A) 0))
+ (iB (aref (cadr B) 0)))
+ (cond ((string= iA iB)
+ (timer-list--next-predicate A B))
+ ((string= iA " *") nil)
+ (t t))))
+
+(defun timer-list--next-predicate (A B)
+ "Predicate to sort Timer-List by the Next column."
+ (let ((nA (string-to-number (aref (cadr A) 1)))
+ (nB (string-to-number (aref (cadr B) 1))))
+ (< nA nB)))
+
+(defun timer-list--repeat-predicate (A B)
+ "Predicate to sort Timer-List by the Repeat column."
+ (let ((rA (aref (cadr A) 2))
+ (rB (aref (cadr B) 2)))
+ (string< rA rB)))
+
+(defun timer-list--function-predicate (A B)
+ "Predicate to sort Timer-List by the Next column."
+ (let ((fA (aref (cadr A) 3))
+ (fB (aref (cadr B) 3)))
+ (string< fA fB)))
(defun timer-list-cancel ()
"Cancel the timer on the line under point."
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
index 492c31b..8e7a34f 100644
--- a/lisp/emulation/viper.el
+++ b/lisp/emulation/viper.el
@@ -1221,7 +1221,6 @@ These two lines must come in the order given."))
(viper-harness-minor-mode "outline")
(viper-harness-minor-mode "allout")
(viper-harness-minor-mode "xref")
- (viper-harness-minor-mode "lmenu")
(viper-harness-minor-mode "vc")
(viper-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX, which
(viper-harness-minor-mode "latex") ; sits in one of these two files
diff --git a/lisp/env.el b/lisp/env.el
index ca2a977..6de9038 100644
--- a/lisp/env.el
+++ b/lisp/env.el
@@ -68,10 +68,10 @@ with a character not a letter, digit or underscore;
otherwise, enclose
the entire variable name in braces. For instance, in `ab$cd-x',
`$cd' is treated as an environment variable.
-If WHEN-DEFINED is nil, references to undefined environment variables
-are replaced by the empty string; if it is a function, the function is called
-with the variable name as argument and should return the text with which
-to replace it or nil to leave it unchanged.
+If WHEN-UNDEFINED is omitted or nil, references to undefined environment
+variables are replaced by the empty string; if it is a function, the
+function is called with the variable's name as argument, and should return
+the text with which to replace it, or nil to leave it unchanged.
If it is non-nil and not a function, references to undefined variables are
left unchanged.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index 57c8e73..1e2526f 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -466,7 +466,8 @@ If this is set to nil, never try to reconnect."
The length is specified in `erc-split-line-length'.
Currently this is called by `erc-send-input'."
- (let ((charset (car (erc-coding-system-for-target nil))))
+ (let* ((coding (erc-coding-system-for-target nil))
+ (charset (if (consp coding) (car coding) coding)))
(with-temp-buffer
(insert longline)
;; The line lengths are in octets, not characters (because these
diff --git a/lisp/eshell/eshell.el b/lisp/eshell/eshell.el
index 2a63882..5ffb159 100644
--- a/lisp/eshell/eshell.el
+++ b/lisp/eshell/eshell.el
@@ -265,14 +265,18 @@ information on Eshell, see Info node `(eshell)Top'."
(eshell-mode))
buf))
-(defun eshell-return-exits-minibuffer ()
- ;; This is supposedly run after enabling esh-mode, when eshell-mode-map
- ;; already exists.
- (defvar eshell-mode-map)
- (define-key eshell-mode-map [(control ?g)] 'abort-recursive-edit)
- (define-key eshell-mode-map [(control ?m)] 'exit-minibuffer)
- (define-key eshell-mode-map [(control ?j)] 'exit-minibuffer)
- (define-key eshell-mode-map [(meta control ?m)] 'exit-minibuffer))
+(define-minor-mode eshell-command-mode
+ "Minor mode for `eshell-command' input.
+\\{eshell-command-mode-map}"
+ :keymap (let ((map (make-sparse-keymap)))
+ (define-key map [(control ?g)] 'abort-recursive-edit)
+ (define-key map [(control ?m)] 'exit-minibuffer)
+ (define-key map [(control ?j)] 'exit-minibuffer)
+ (define-key map [(meta control ?m)] 'exit-minibuffer)
+ map))
+
+(define-obsolete-function-alias 'eshell-return-exits-minibuffer
+ #'eshell-command-mode "28.1")
(defvar eshell-non-interactive-p nil
"A variable which is non-nil when Eshell is not running interactively.
@@ -292,7 +296,7 @@ With prefix ARG, insert output into the current buffer at
point."
;; Enable `eshell-mode' only in this minibuffer.
(minibuffer-with-setup-hook #'(lambda ()
(eshell-mode)
- (eshell-return-exits-minibuffer))
+ (eshell-command-mode +1))
(unless command
(setq command (read-from-minibuffer "Emacs shell command: "))
(if (eshell-using-module 'eshell-hist)
diff --git a/lisp/ffap.el b/lisp/ffap.el
index ead79b4..ceba9d2 100644
--- a/lisp/ffap.el
+++ b/lisp/ffap.el
@@ -54,6 +54,8 @@
;; C-x 5 r ffap-read-only-other-frame
;; C-x 5 d ffap-dired-other-frame
;;
+;; C-x t f ffap-other-tab
+;;
;; S-mouse-3 ffap-at-mouse
;; C-S-mouse-3 ffap-menu
;;
@@ -1607,7 +1609,7 @@ Each ALIST entry looks like (STRING . DATA) and defines
one choice.
Function CONT is applied to the entry chosen by the user."
;; Note: this function is used with a different continuation
;; by the ffap-url add-on package.
- ;; Could try rewriting to use easymenu.el or lmenu.el.
+ ;; Could try rewriting to use easymenu.el.
(let (choice)
(cond
;; Emacs mouse:
@@ -1758,6 +1760,14 @@ Only intended for interactive use."
(set-window-dedicated-p win wdp))
value))
+(defun ffap-other-tab (filename)
+ "Like `ffap', but put buffer in another tab.
+Only intended for interactive use."
+ (interactive (list (ffap-prompter nil " other tab")))
+ (pcase (save-window-excursion (find-file-at-point filename))
+ ((or (and (pred bufferp) b) `(,(and (pred bufferp) b) . ,_))
+ (switch-to-buffer-other-tab b))))
+
(defun ffap--toggle-read-only (buffer-or-list)
(dolist (buffer (if (listp buffer-or-list)
buffer-or-list
@@ -2013,6 +2023,7 @@ This hook is intended to be put in
`file-name-at-point-functions'."
(global-set-key [remap find-file-other-window] 'ffap-other-window)
(global-set-key [remap find-file-other-frame] 'ffap-other-frame)
+ (global-set-key [remap find-file-other-tab] 'ffap-other-tab)
(global-set-key [remap find-file-read-only-other-window]
'ffap-read-only-other-window)
(global-set-key [remap find-file-read-only-other-frame]
'ffap-read-only-other-frame)
diff --git a/lisp/fileloop.el b/lisp/fileloop.el
index 8f49116..d52e35d 100644
--- a/lisp/fileloop.el
+++ b/lisp/fileloop.el
@@ -181,8 +181,7 @@ operating on the next file and nil otherwise."
(fileloop-initialize
files
(lambda ()
- (let ((case-fold-search
- (if (memq case-fold '(t nil)) case-fold case-fold-search)))
+ (let ((case-fold-search (fileloop--case-fold regexp case-fold)))
(re-search-forward regexp nil t)))
(lambda ()
(unless (eq last-buffer (current-buffer))
@@ -190,13 +189,27 @@ operating on the next file and nil otherwise."
(message "Scanning file %s...found" buffer-file-name))
nil))))
+(defun fileloop--case-fold (regexp case-fold)
+ (let ((value
+ (if (memql case-fold '(nil t))
+ case-fold
+ case-fold-search)))
+ (if (and value search-upper-case)
+ (isearch-no-upper-case-p regexp t)
+ value)))
+
;;;###autoload
(defun fileloop-initialize-replace (from to files case-fold &optional
delimited)
"Initialize a new round of query&replace on several files.
FROM is a regexp and TO is the replacement to use.
-FILES describes the file, as in `fileloop-initialize'.
-CASE-FOLD can be t, nil, or `default', the latter one meaning to obey
-the default setting of `case-fold-search'.
+FILES describes the files, as in `fileloop-initialize'.
+CASE-FOLD can be t, nil, or `default':
+ if it is nil, matching of FROM is case-sensitive.
+ if it is t, matching of FROM is case-insensitive, except
+ when `search-upper-case' is non-nil and FROM includes
+ upper-case letters.
+ if it is `default', the function uses the value of
+ `case-fold-search' instead.
DELIMITED if non-nil means replace only word-delimited matches."
;; FIXME: Not sure how the delimited-flag interacts with the regexp-flag in
;; `perform-replace', so I just try to mimic the old code.
@@ -204,8 +217,7 @@ DELIMITED if non-nil means replace only word-delimited
matches."
(fileloop-initialize
files
(lambda ()
- (let ((case-fold-search
- (if (memql case-fold '(nil t)) case-fold case-fold-search)))
+ (let ((case-fold-search (fileloop--case-fold from case-fold)))
(when (re-search-forward from nil t)
;; When we find a match, save its beginning for
;; `perform-replace' (we used to just set point, but this
@@ -213,9 +225,10 @@ DELIMITED if non-nil means replace only word-delimited
matches."
;; `switch-to-buffer-preserve-window-point').
(puthash (current-buffer) (match-beginning 0) mstart))))
(lambda ()
- (perform-replace from to t t delimited nil multi-query-replace-map
- (gethash (current-buffer) mstart (point-min))
- (point-max))))))
+ (let ((case-fold-search (fileloop--case-fold from case-fold)))
+ (perform-replace from to t t delimited nil multi-query-replace-map
+ (gethash (current-buffer) mstart (point-min))
+ (point-max)))))))
(provide 'fileloop)
;;; fileloop.el ends here
diff --git a/lisp/files.el b/lisp/files.el
index fa72e51..cefae20 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -430,7 +430,13 @@ idle for `auto-save-visited-interval' seconds."
Unlike `auto-save-mode', this mode will auto-save buffer contents
to the visited files directly and will also run all save-related
-hooks. See Info node `Saving' for details of the save process."
+hooks. See Info node `Saving' for details of the save process.
+
+You can also set the buffer-local value of the variable
+`auto-save-visited-mode' to nil. A buffer where the buffer-local
+value of this variable is nil is ignored for the purpose of
+`auto-save-visited-mode', even if `auto-save-visited-mode' is
+enabled."
:group 'auto-save
:global t
(when auto-save--timer (cancel-timer auto-save--timer))
@@ -441,6 +447,7 @@ hooks. See Info node `Saving' for details of the save
process."
#'save-some-buffers :no-prompt
(lambda ()
(and buffer-file-name
+ auto-save-visited-mode
(not (and buffer-auto-save-file-name
auto-save-visited-file-name))))))))
@@ -2657,6 +2664,13 @@ since only a single case-insensitive search through the
alist is made."
("\\.ltx\\'" . latex-mode)
("\\.dtx\\'" . doctex-mode)
("\\.org\\'" . org-mode)
+ ;; .dir-locals.el is not really Elisp. Could use the
+ ;; `dir-locals-file' constant if it weren't defined below.
+ ("\\.dir-locals\\(?:-2\\)?\\.el\\'" . lisp-data-mode)
+ ("eww-bookmarks\\'" . lisp-data-mode)
+ ("tramp\\'" . lisp-data-mode)
+ ("places\\'" . lisp-data-mode)
+ ("\\.emacs-places\\'" . lisp-data-mode)
("\\.el\\'" . emacs-lisp-mode)
("Project\\.ede\\'" . emacs-lisp-mode)
("\\.\\(scm\\|stk\\|ss\\|sch\\)\\'" . scheme-mode)
@@ -7545,6 +7559,27 @@ as in \"og+rX-w\"."
op char-right)))
num-rights))
+(defun file-modes-number-to-symbolic (mode)
+ (string
+ (if (zerop (logand 8192 mode))
+ (if (zerop (logand 16384 mode)) ?- ?d)
+ ?c) ; completeness
+ (if (zerop (logand 256 mode)) ?- ?r)
+ (if (zerop (logand 128 mode)) ?- ?w)
+ (if (zerop (logand 64 mode))
+ (if (zerop (logand 2048 mode)) ?- ?S)
+ (if (zerop (logand 2048 mode)) ?x ?s))
+ (if (zerop (logand 32 mode)) ?- ?r)
+ (if (zerop (logand 16 mode)) ?- ?w)
+ (if (zerop (logand 8 mode))
+ (if (zerop (logand 1024 mode)) ?- ?S)
+ (if (zerop (logand 1024 mode)) ?x ?s))
+ (if (zerop (logand 4 mode)) ?- ?r)
+ (if (zerop (logand 2 mode)) ?- ?w)
+ (if (zerop (logand 512 mode))
+ (if (zerop (logand 1 mode)) ?- ?x)
+ (if (zerop (logand 1 mode)) ?T ?t))))
+
(defun file-modes-symbolic-to-number (modes &optional from)
"Convert symbolic file modes to numeric file modes.
MODES is the string to convert, it should match
diff --git a/lisp/frameset.el b/lisp/frameset.el
index 10c6914..0462d77 100644
--- a/lisp/frameset.el
+++ b/lisp/frameset.el
@@ -396,17 +396,17 @@ Properties can be set with
;; or, if you're only changing a few items,
;;
;; (defvar my-filter-alist
-;; (nconc '((my-param1 . :never)
-;; (my-param2 . my-filtering-function))
-;; frameset-filter-alist)
+;; (append '((my-param1 . :never)
+;; (my-param2 . my-filtering-function))
+;; frameset-filter-alist)
;; "My brief customized parameter filter alist.")
;;
;; and pass it to the FILTER arg of the save/restore functions,
;; ALWAYS taking care of not modifying the original lists; if you're
;; going to do any modifying of my-filter-alist, please use
;;
-;; (nconc '((my-param1 . :never) ...)
-;; (copy-sequence frameset-filter-alist))
+;; (append '((my-param1 . :never) ...)
+;; (copy-sequence frameset-filter-alist))
;;
;; One thing you shouldn't forget is that they are alists, so searching
;; in them is sequential. If you just want to change the default of
@@ -445,7 +445,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full
description.")
;;;###autoload
(defvar frameset-persistent-filter-alist
- (nconc
+ (append
'((background-color . frameset-filter-sanitize-color)
(buffer-list . :never)
(buffer-predicate . :never)
diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el
index 2df098b..6d24b40 100644
--- a/lisp/gnus/gmm-utils.el
+++ b/lisp/gnus/gmm-utils.el
@@ -168,9 +168,9 @@ ARGS are passed to `message'."
(defcustom gmm-tool-bar-style
(if (and (boundp 'tool-bar-mode)
tool-bar-mode
- (memq (display-visual-class)
- (list 'static-gray 'gray-scale
- 'static-color 'pseudo-color)))
+ (not (memq (display-visual-class)
+ (list 'static-gray 'gray-scale
+ 'static-color 'pseudo-color))))
'gnome
'retro)
"Preferred tool bar style."
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index 6b9610d..614651a 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -5833,6 +5833,7 @@ all parts."
"" "..."))
(gnus-tmp-length (with-current-buffer (mm-handle-buffer handle)
(buffer-size)))
+ (help-echo "mouse-2: toggle the MIME part; down-mouse-3: more options")
gnus-tmp-type-long b e)
(when (string-match ".*/" gnus-tmp-name)
(setq gnus-tmp-name (replace-match "" t t gnus-tmp-name)))
@@ -5841,6 +5842,16 @@ all parts."
(concat "; " gnus-tmp-name))))
(unless (equal gnus-tmp-description "")
(setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
+ (when (zerop gnus-tmp-length)
+ (setq gnus-tmp-type-long
+ (concat
+ gnus-tmp-type-long
+ (substitute-command-keys
+ (concat "\\<gnus-summary-mode-map> (not downloaded, "
+ "\\[gnus-summary-show-complete-article] to fetch.)"))))
+ (setq help-echo
+ (concat "Type \\[gnus-summary-show-complete-article] "
+ "to download complete article. " help-echo)))
(setq b (point))
(gnus-eval-format
gnus-mime-button-line-format gnus-mime-button-line-format-alist
@@ -5859,8 +5870,7 @@ all parts."
'keymap gnus-mime-button-map
'face gnus-article-button-face
'follow-link t
- 'help-echo
- "mouse-2: toggle the MIME part; down-mouse-3: more options")))
+ 'help-echo help-echo)))
(defvar gnus-displaying-mime nil)
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 480ed80..f306889 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -485,23 +485,25 @@ This is not required after changing
`gnus-registry-cache-file'."
(when from
(setq entry (cons (delete from (assoc 'group entry))
(assq-delete-all 'group entry))))
-
- (dolist (kv `((group ,to)
- (sender ,sender)
- (recipient ,@recipients)
- (subject ,subject)))
- (when (cadr kv)
- (let ((new (or (assq (car kv) entry)
- (list (car kv)))))
- (dolist (toadd (cdr kv))
- (unless (member toadd new)
- (setq new (append new (list toadd)))))
- (setq entry (cons new
- (assq-delete-all (car kv) entry))))))
- (gnus-message 10 "Gnus registry: new entry for %s is %S"
- id
- entry)
- (gnus-registry-insert db id entry)))
+ ;; Only keep the entry if the message is going to a new group, or
+ ;; it's still in some previous group.
+ (when (or to (alist-get 'group entry))
+ (dolist (kv `((group ,to)
+ (sender ,sender)
+ (recipient ,@recipients)
+ (subject ,subject)))
+ (when (cadr kv)
+ (let ((new (or (assq (car kv) entry)
+ (list (car kv)))))
+ (dolist (toadd (cdr kv))
+ (unless (member toadd new)
+ (setq new (append new (list toadd)))))
+ (setq entry (cons new
+ (assq-delete-all (car kv) entry))))))
+ (gnus-message 10 "Gnus registry: new entry for %s is %S"
+ id
+ entry)
+ (gnus-registry-insert db id entry))))
;; Function for nn{mail|imap}-split-fancy: look up all references in
;; the cache and if a match is found, return that group.
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 6f36769..341f04a 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -1501,9 +1501,9 @@ the type of the variable (string, integer, character,
etc).")
;; This is here rather than in gnus-art for compilation reasons.
(defvar gnus-article-mode-line-format-alist
- (nconc '((?w (gnus-article-wash-status) ?s)
- (?m (gnus-article-mime-part-status) ?s))
- gnus-summary-mode-line-format-alist))
+ (append '((?w (gnus-article-wash-status) ?s)
+ (?m (gnus-article-mime-part-status) ?s))
+ gnus-summary-mode-line-format-alist))
(defvar gnus-last-search-regexp nil
"Default regexp for article search command.")
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index eb9c79d..5a6827a 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -873,8 +873,8 @@ If this is nil, use `user-mail-address'. If it is the
symbol
message-sendmail-envelope-from))
(defcustom message-sendmail-extra-arguments nil
- "Additional arguments to `sendmail-program'."
- ;; E.g. '("-a" "account") for msmtp
+ "Additional arguments to `sendmail-program'.
+A list of strings, e.g. (\"-a\" \"account\") for msmtp."
:version "23.1" ;; No Gnus
:type '(repeat string)
;; :link '(custom-manual "(message)Mail Variables")
@@ -7984,7 +7984,7 @@ See `gmm-tool-bar-from-list' for details on the format of
the list."
(defcustom message-tool-bar-retro
'(;; Old Emacs 21 icon for consistency.
- (message-send-and-exit "gnus/mail-send")
+ (message-send-and-exit "mail/send")
(message-kill-buffer "close")
(message-dont-send "cancel")
(mml-attach-file "attach" mml-mode-map)
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 0a99b8d..63b066f 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -893,7 +893,7 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
(output nil))
(if custom-version
(setq output
- (format "This %s was introduced, or its default value was
changed, in\nversion %s of Emacs.\n"
+ (format " This %s was introduced, or its default value was
changed, in\n version %s of Emacs.\n"
type custom-version))
(when cpv
(let* ((package (car-safe cpv))
@@ -904,7 +904,7 @@ If ANY-SYMBOL is non-nil, don't insist the symbol be bound."
(emacsv (cdr (assoc version pkg-versions))))
(if (and package version)
(setq output
- (format (concat "This %s was introduced, or its default
value was changed, in\nversion %s of the %s package"
+ (format (concat " This %s was introduced, or its default
value was changed, in\n version %s of the %s package"
(if emacsv
(format " that is part of Emacs %s"
emacsv))
".\n")
@@ -1125,8 +1125,8 @@ it is displayed along with the global value."
;; Note variable's version or package version.
(let ((output (describe-variable-custom-version-info variable)))
(when output
- (terpri)
- (terpri)
+ ;; (terpri)
+ ;; (terpri)
(princ output)))))
(add-hook 'help-fns-describe-variable-functions #'help-fns--var-safe-local)
diff --git a/lisp/help-mode.el b/lisp/help-mode.el
index bae8281..9c2d1d7 100644
--- a/lisp/help-mode.el
+++ b/lisp/help-mode.el
@@ -1,4 +1,4 @@
-;;; help-mode.el --- `help-mode' used by *Help* buffers
+;;; help-mode.el --- `help-mode' used by *Help* buffers -*- lexical-binding:
t; -*-
;; Copyright (C) 1985-1986, 1993-1994, 1998-2020 Free Software
;; Foundation, Inc.
@@ -47,10 +47,10 @@
(define-key map "\C-c\C-c" 'help-follow-symbol)
(define-key map "\r" 'help-follow)
map)
- "Keymap for help mode.")
+ "Keymap for Help mode.")
(easy-menu-define help-mode-menu help-mode-map
- "Menu for Help Mode."
+ "Menu for Help mode."
'("Help-Mode"
["Show Help for Symbol" help-follow-symbol
:help "Show the docs for the symbol at point"]
@@ -327,13 +327,13 @@ Commands:
;;;###autoload
(defun help-mode-setup ()
- "Enter Help Mode in the current buffer."
+ "Enter Help mode in the current buffer."
(help-mode)
(setq buffer-read-only nil))
;;;###autoload
(defun help-mode-finish ()
- "Finalize Help Mode setup in current buffer."
+ "Finalize Help mode setup in current buffer."
(when (derived-mode-p 'help-mode)
(setq buffer-read-only t)
(help-make-xrefs (current-buffer))))
@@ -719,7 +719,8 @@ a proper [back] button."
;; There is a reference at point. Follow it.
(let ((help-xref-following t))
(apply function (if (eq function 'info)
- (append args (list (generate-new-buffer-name
"*info*"))) args))))
+ (append args (list (generate-new-buffer-name
"*info*")))
+ args))))
;; The doc string is meant to explain what buttons do.
(defun help-follow-mouse ()
diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 08d8217..a183103 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -322,7 +322,10 @@ or add (global-hi-lock-mode 1) to your init file.
In buffers where Font Lock mode is enabled, patterns are
highlighted using font lock. In buffers where Font Lock mode is
disabled, patterns are applied using overlays; in this case, the
-highlighting will not be updated as you type.
+highlighting will not be updated as you type. The Font Lock mode
+is considered \"enabled\" in a buffer if its `major-mode'
+causes `font-lock-specified-p' to return non-nil, which means
+the major mode specifies support for Font Lock.
When Hi Lock mode is enabled, a \"Regexp Highlighting\" submenu
is added to the \"Edit\" menu. The commands in the submenu,
@@ -480,7 +483,10 @@ and `search-upper-case' is non-nil, the matching is
case-sensitive.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
-highlighting will not update as you type."
+highlighting will not update as you type. The Font Lock mode
+is considered \"enabled\" in a buffer if its `major-mode'
+causes `font-lock-specified-p' to return non-nil, which means
+the major mode specifies support for Font Lock."
(interactive
(list
(hi-lock-regexp-okay
@@ -510,7 +516,10 @@ Also set `search-spaces-regexp' to the value of
`search-whitespace-regexp'.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
-highlighting will not update as you type."
+highlighting will not update as you type. The Font Lock mode
+is considered \"enabled\" in a buffer if its `major-mode'
+causes `font-lock-specified-p' to return non-nil, which means
+the major mode specifies support for Font Lock."
(interactive
(list
(hi-lock-regexp-okay
@@ -538,7 +547,10 @@ If REGEXP contains upper case characters (excluding those
preceded by `\\')
and `search-upper-case' is non-nil, the matching is case-sensitive.
This uses Font lock mode if it is enabled; otherwise it uses overlays,
-in which case the highlighting will not update as you type."
+in which case the highlighting will not update as you type. The Font
+Lock mode is considered \"enabled\" in a buffer if its `major-mode'
+causes `font-lock-specified-p' to return non-nil, which means
+the major mode specifies support for Font Lock."
(interactive)
(let* ((regexp (hi-lock-regexp-okay
(find-tag-default-as-symbol-regexp)))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 7a5d88c..6265537 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -11,9 +11,6 @@
;; Created: 2002-01-05
;; Description: htmlize a buffer/source tree with optional hyperlinks
;; URL: http://rtfm.etla.org/emacs/htmlfontify/
-;; Compatibility: Emacs23, Emacs22
-;; Incompatibility: Emacs19, Emacs20, Emacs21
-;; Last Updated: Thu 2009-11-19 01:31:21 +0000
;; This file is part of GNU Emacs.
diff --git a/lisp/ido.el b/lisp/ido.el
index 8188340..ad71d46 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -499,11 +499,14 @@ This means that \\[ido-complete] must always be followed
by \\[ido-exit-minibuff
even when there is only one unique completion."
:type 'boolean)
-(defcustom ido-cannot-complete-command 'ido-completion-help
+(defcustom ido-cannot-complete-command #'ido-completion-auto-help
"Command run when `ido-complete' can't complete any more.
The most useful values are `ido-completion-help', which pops up a
-window with completion alternatives, or `ido-next-match' or
-`ido-prev-match', which cycle the buffer list."
+window with completion alternatives; `ido-completion-auto-help',
+which does the same but respects the value of
+`completion-auto-help'; and `ido-next-match' or `ido-prev-match',
+which cycle the buffer list."
+ :version "28.1"
:type 'function)
@@ -1546,7 +1549,7 @@ This function also adds a hook to the minibuffer."
((> (prefix-numeric-value arg) 0) 'both)
(t nil)))
- (ido-everywhere (if ido-everywhere 1 -1))
+ (ido-everywhere (if (and ido-mode ido-everywhere) 1 -1))
(when ido-mode
(ido-common-initialization)
@@ -3926,6 +3929,14 @@ If `ido-change-word-sub' cannot be found in WORD, return
nil."
(when (bobp)
(next-completion 1)))))
+(defun ido-completion-auto-help ()
+ "Call `ido-completion-help' if `completion-auto-help' is non-nil."
+ (interactive)
+ ;; Note: `completion-auto-help' could also be `lazy', but this value
+ ;; is irrelevant to ido, which is fundamentally eager, so it is
+ ;; treated the same as t.
+ (when completion-auto-help
+ (ido-completion-help)))
(defun ido-completion-help ()
"Show possible completions in the `ido-completion-buffer'."
diff --git a/lisp/ielm.el b/lisp/ielm.el
index fc06ebf..47c5158 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -44,8 +44,7 @@
(defcustom ielm-noisy t
"If non-nil, IELM will beep on error."
- :type 'boolean
- :group 'ielm)
+ :type 'boolean)
(defcustom ielm-prompt-read-only t
"If non-nil, the IELM prompt is read only.
@@ -74,7 +73,6 @@ buffers, including IELM buffers. If you sometimes use IELM on
text-only terminals or with `emacs -nw', you might wish to use
another binding for `comint-kill-whole-line'."
:type 'boolean
- :group 'ielm
:version "22.1")
(defcustom ielm-prompt "ELISP> "
@@ -90,8 +88,7 @@ does not update the prompt of an *ielm* buffer with a running
process.
For IELM buffers that are not called `*ielm*', you can execute
\\[inferior-emacs-lisp-mode] in that IELM buffer to update the value,
for new prompts. This works even if the buffer has a running process."
- :type 'string
- :group 'ielm)
+ :type 'string)
(defvar ielm-prompt-internal "ELISP> "
"Stored value of `ielm-prompt' in the current IELM buffer.
@@ -103,8 +100,7 @@ customizes `ielm-prompt'.")
"Controls whether \\<ielm-map>\\[ielm-return] has intelligent behavior in
IELM.
If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a
newline
and indents for incomplete sexps. If nil, always inserts newlines."
- :type 'boolean
- :group 'ielm)
+ :type 'boolean)
(defcustom ielm-dynamic-multiline-inputs t
"Force multiline inputs to start from column zero?
@@ -112,15 +108,13 @@ If non-nil, after entering the first line of an
incomplete sexp, a newline
will be inserted after the prompt, moving the input to the next line.
This gives more frame width for large indented sexps, and allows functions
such as `edebug-defun' to work with such inputs."
- :type 'boolean
- :group 'ielm)
+ :type 'boolean)
(defvaralias 'inferior-emacs-lisp-mode-hook 'ielm-mode-hook)
(defcustom ielm-mode-hook nil
"Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started."
:options '(eldoc-mode)
- :type 'hook
- :group 'ielm)
+ :type 'hook)
;; We define these symbols (that are only used buffer-locally in ielm
;; buffers) this way to avoid having them be defined in the global
@@ -366,9 +360,9 @@ nonempty, then flushes the buffer."
;; that same let. To avoid problems, neither of
;; these buffers should be alive during the
;; evaluation of form.
- (let* ((*1 *)
- (*2 **)
- (*3 ***)
+ (let* ((*1 (bound-and-true-p *))
+ (*2 (bound-and-true-p **))
+ (*3 (bound-and-true-p ***))
(active-process (ielm-process))
(old-standard-output standard-output)
new-standard-output
@@ -453,11 +447,12 @@ nonempty, then flushes the buffer."
(if error-type
(progn
(when ielm-noisy (ding))
- (setq output (concat output "*** " error-type " *** "))
- (setq output (concat output result)))
+ (setq output (concat output
+ "*** " error-type " *** "
+ result)))
;; There was no error, so shift the *** values
- (setq *** **)
- (setq ** *)
+ (setq *** (bound-and-true-p **))
+ (setq ** (bound-and-true-p *))
(setq * result))
(when (or (not for-effect) (not (equal output "")))
(setq output (concat output "\n"))))
diff --git a/lisp/image-mode.el b/lisp/image-mode.el
index 3ee185a..480b2e6 100644
--- a/lisp/image-mode.el
+++ b/lisp/image-mode.el
@@ -505,16 +505,22 @@ call."
"--"
["Fit Frame to Image" image-mode-fit-frame :active t
:help "Resize frame to match image"]
+ ["Fit Image to Window (Best Fit)" image-transform-fit-both
+ :help "Resize image to match the window height and width"]
["Fit to Window Height" image-transform-fit-to-height
:help "Resize image to match the window height"]
["Fit to Window Width" image-transform-fit-to-width
:help "Resize image to match the window width"]
- ["Fit to Window Height and Width" image-transform-fit-both
- :help "Resize image to match the window height and width"]
+ ["Zoom In" image-increase-size
+ :help "Enlarge the image"]
+ ["Zoom Out" image-decrease-size
+ :help "Shrink the image"]
["Set Scale..." image-transform-set-scale
:help "Resize image by specified scale factor"]
- ["Rotate Image..." image-transform-set-rotation
+ ["Rotate Clockwise" image-rotate
:help "Rotate the image"]
+ ["Set Rotation..." image-transform-set-rotation
+ :help "Set rotation angle of the image"]
["Reset Transformations" image-transform-reset
:help "Reset all image transformations"]
"--"
@@ -524,10 +530,10 @@ call."
(image-dired default-directory))
:active default-directory
:help "Show thumbnails for all images in this directory"]
- ["Next Image" image-next-file :active buffer-file-name
- :help "Move to next image in this directory"]
["Previous Image" image-previous-file :active buffer-file-name
:help "Move to previous image in this directory"]
+ ["Next Image" image-next-file :active buffer-file-name
+ :help "Move to next image in this directory"]
["Copy File Name" image-mode-copy-file-name-as-kill
:active buffer-file-name
:help "Copy the current file name to the kill ring"]
@@ -565,10 +571,10 @@ call."
["Reset Animation Speed" image-reset-speed
:active image-multi-frame
:help "Reset the speed of this image's animation"]
- ["Next Frame" image-next-frame :active image-multi-frame
- :help "Show the next frame of this image"]
["Previous Frame" image-previous-frame :active image-multi-frame
:help "Show the previous frame of this image"]
+ ["Next Frame" image-next-frame :active image-multi-frame
+ :help "Show the next frame of this image"]
["Goto Frame..." image-goto-frame :active image-multi-frame
:help "Show a specific frame of this image"]
))
diff --git a/lisp/info.el b/lisp/info.el
index 3015e60..d579ecc 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -4079,22 +4079,28 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:help "Go to top node of file"]
["Final Node" Info-final-node
:help "Go to final node in this file"]
+ "---"
("Menu Item" ["You should never see this" report-emacs-bug t])
("Reference" ["You should never see this" report-emacs-bug t])
["Search..." Info-search
:help "Search for regular expression in this Info file"]
["Search Next" Info-search-next
:help "Search for another occurrence of regular expression"]
- ["Go to Node..." Info-goto-node
+ "---"
+ ("History"
+ ["Back in history" Info-history-back :active Info-history
+ :help "Go back in history to the last node you were at"]
+ ["Forward in history" Info-history-forward :active Info-history-forward
+ :help "Go forward in history"]
+ ["Show History" Info-history :active Info-history-list
+ :help "Go to menu of visited nodes"])
+ ("Go to"
+ ["Go to Node..." Info-goto-node
:help "Go to a named node"]
- ["Back in history" Info-history-back :active Info-history
- :help "Go back in history to the last node you were at"]
- ["Forward in history" Info-history-forward :active Info-history-forward
- :help "Go forward in history"]
- ["History" Info-history :active Info-history-list
- :help "Go to menu of visited nodes"]
- ["Table of Contents" Info-toc
- :help "Go to table of contents"]
+ ["Table of Contents" Info-toc
+ :help "Go to table of contents"]
+ ["Go to Directory" Info-directory
+ :help "Go to the Info directory node."])
("Index"
["Lookup a String..." Info-index
:help "Look for a string in the index items"]
@@ -4108,6 +4114,7 @@ If FORK is non-nil, it is passed to `Info-goto-node'."
:help "Copy the name of the current node into the kill ring"]
["Clone Info buffer" clone-buffer
:help "Create a twin copy of the current Info buffer."]
+ "---"
["Exit" quit-window :help "Stop reading Info"]))
@@ -4358,6 +4365,7 @@ Moving within a node:
already visible, try to go to the previous menu entry, or up
if there is none.
\\[beginning-of-buffer] Go to beginning of node.
+\\[end-of-buffer] Go to end of node.
Advanced commands:
\\[Info-search] Search through this Info file for specified regexp,
diff --git a/lisp/isearch.el b/lisp/isearch.el
index e13a4dd..81e83d7 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -319,7 +319,7 @@ this variable is set to the symbol `all-windows'."
"Show match numbers in the search prompt.
When both this option and `isearch-lazy-highlight' are non-nil,
show the current match number and the total number of matches
-in the buffer (or its restriction)."
+in the buffer (or its restriction), including all hidden matches."
:type 'boolean
:group 'lazy-count
:group 'isearch
@@ -3869,7 +3869,10 @@ Attempt to do the search exactly the way the pending
Isearch would."
(isearch-regexp-lax-whitespace
isearch-lazy-highlight-regexp-lax-whitespace)
(isearch-forward isearch-lazy-highlight-forward)
- (search-invisible nil) ; don't match invisible text
+ ;; Don't match invisible text unless it can be opened
+ ;; or when counting matches and user can visit hidden matches
+ (search-invisible (or (eq search-invisible 'open)
+ (and isearch-lazy-count search-invisible)))
(retry t)
(success nil))
;; Use a loop like in `isearch-search'.
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index c0c9cac..8b3384a 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -147,9 +147,10 @@ If 0, then fontification is only deferred while there is
input pending."
(defvar-local jit-lock-mode nil
"Non-nil means Just-in-time Lock mode is active.")
-(defvar-local jit-lock-functions nil
- "Functions to do the actual fontification.
-They are called with two arguments: the START and END of the region to
fontify.")
+(defvar jit-lock-functions nil
+ "Special hook run to do the actual fontification.
+The functions are called with two arguments:
+the START and END of the region to fontify.")
(defvar-local jit-lock-context-unfontify-pos nil
"Consider text after this position as contextually unfontified.
@@ -341,7 +342,8 @@ If non-nil, CONTEXTUAL means that a contextual
fontification would be useful."
"Unregister FUN as a fontification function.
Only applies to the current buffer."
(remove-hook 'jit-lock-functions fun t)
- (unless jit-lock-functions (jit-lock-mode nil)))
+ (when (member jit-lock-functions '(nil '(t)))
+ (jit-lock-mode nil)))
(defun jit-lock-refontify (&optional beg end)
"Force refontification of the region BEG..END (default whole buffer)."
diff --git a/lisp/json.el b/lisp/json.el
index 6f3b791..9002e86 100644
--- a/lisp/json.el
+++ b/lisp/json.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2006-2020 Free Software Foundation, Inc.
;; Author: Theresa O'Connor <ted@oconnor.cx>
-;; Version: 1.4
+;; Version: 1.5
;; Keywords: convenience
;; This file is part of GNU Emacs.
@@ -29,11 +29,11 @@
;; Learn all about JSON here: <URL:http://json.org/>.
;; The user-serviceable entry points for the parser are the functions
-;; `json-read' and `json-read-from-string'. The encoder has a single
+;; `json-read' and `json-read-from-string'. The encoder has a single
;; entry point, `json-encode'.
;; Since there are several natural representations of key-value pair
-;; mappings in elisp (alist, plist, hash-table), `json-read' allows you
+;; mappings in Elisp (alist, plist, hash-table), `json-read' allows you
;; to specify which you'd prefer (see `json-object-type' and
;; `json-array-type').
@@ -55,6 +55,7 @@
;;; Code:
(require 'map)
+(require 'seq)
(require 'subr-x)
;; Parameters
@@ -113,8 +114,10 @@ Used only when `json-encoding-pretty-print' is non-nil.")
"If non-nil, then the output of `json-encode' will be pretty-printed.")
(defvar json-encoding-lisp-style-closings nil
- "If non-nil, ] and } closings will be formatted lisp-style,
-without indentation.")
+ "If non-nil, delimiters ] and } will be formatted Lisp-style.
+This means they will be placed on the same line as the last
+element of the respective array or object, without indentation.
+Used only when `json-encoding-pretty-print' is non-nil.")
(defvar json-encoding-object-sort-predicate nil
"Sorting predicate for JSON object keys during encoding.
@@ -124,88 +127,81 @@ instance, setting this to `string<' will have JSON object
keys
ordered alphabetically.")
(defvar json-pre-element-read-function nil
- "Function called (if non-nil) by `json-read-array' and
-`json-read-object' right before reading a JSON array or object,
-respectively. The function is called with one argument, which is
-the current JSON key.")
+ "If non-nil, a function to call before reading a JSON array or object.
+It is called by `json-read-array' and `json-read-object',
+respectively, with one argument, which is the current JSON key.")
(defvar json-post-element-read-function nil
- "Function called (if non-nil) by `json-read-array' and
-`json-read-object' right after reading a JSON array or object,
-respectively.")
+ "If non-nil, a function to call after reading a JSON array or object.
+It is called by `json-read-array' and `json-read-object',
+respectively, with no arguments.")
;;; Utilities
-(defun json-join (strings separator)
- "Join STRINGS with SEPARATOR."
- (mapconcat 'identity strings separator))
+(define-obsolete-function-alias 'json-join #'string-join "28.1")
(defun json-alist-p (list)
- "Non-null if and only if LIST is an alist with simple keys."
- (while (consp list)
- (setq list (if (and (consp (car list))
- (atom (caar list)))
- (cdr list)
- 'not-alist)))
+ "Non-nil if and only if LIST is an alist with simple keys."
+ (declare (pure t) (side-effect-free error-free))
+ (while (and (consp (car-safe list))
+ (atom (caar list))
+ (setq list (cdr list))))
(null list))
(defun json-plist-p (list)
- "Non-null if and only if LIST is a plist with keyword keys."
- (while (consp list)
- (setq list (if (and (keywordp (car list))
- (consp (cdr list)))
- (cddr list)
- 'not-plist)))
+ "Non-nil if and only if LIST is a plist with keyword keys."
+ (declare (pure t) (side-effect-free error-free))
+ (while (and (keywordp (car-safe list))
+ (consp (cdr list))
+ (setq list (cddr list))))
(null list))
-(defun json--plist-reverse (plist)
- "Return a copy of PLIST in reverse order.
-Unlike `reverse', this keeps the property-value pairs intact."
- (let (res)
- (while plist
- (let ((prop (pop plist))
- (val (pop plist)))
- (push val res)
- (push prop res)))
- res))
-
-(defun json--plist-to-alist (plist)
- "Return an alist of the property-value pairs in PLIST."
- (let (res)
- (while plist
- (let ((prop (pop plist))
- (val (pop plist)))
- (push (cons prop val) res)))
- (nreverse res)))
-
-(defmacro json--with-indentation (body)
+(defun json--plist-nreverse (plist)
+ "Return PLIST in reverse order.
+Unlike `nreverse', this keeps the ordering of each property
+relative to its value intact. Like `nreverse', this function may
+destructively modify PLIST to produce the result."
+ (let (prev (next (cddr plist)))
+ (while next
+ (setcdr (cdr plist) prev)
+ (setq prev plist plist next next (cddr next))
+ (setcdr (cdr plist) prev)))
+ plist)
+
+(defmacro json--with-indentation (&rest body)
+ "Evaluate BODY with the correct indentation for JSON encoding.
+This macro binds `json--encoding-current-indentation' according
+to `json-encoding-pretty-print' around BODY."
+ (declare (debug t) (indent 0))
`(let ((json--encoding-current-indentation
(if json-encoding-pretty-print
(concat json--encoding-current-indentation
json-encoding-default-indentation)
"")))
- ,body))
+ ,@body))
;; Reader utilities
(define-inline json-advance (&optional n)
- "Advance N characters forward."
+ "Advance N characters forward, or 1 character if N is nil.
+On reaching the end of the accessible region of the buffer, stop
+and signal an error."
(inline-quote (forward-char ,n)))
(define-inline json-peek ()
- "Return the character at point."
+ "Return the character at point.
+At the end of the accessible region of the buffer, return 0."
(inline-quote (following-char)))
(define-inline json-pop ()
- "Advance past the character at point, returning it."
+ "Advance past the character at point, returning it.
+Signal `json-end-of-file' if called at the end of the buffer."
(inline-quote
- (let ((char (json-peek)))
- (if (zerop char)
- (signal 'json-end-of-file nil)
- (json-advance)
- char))))
+ (prog1 (or (char-after)
+ (signal 'json-end-of-file ()))
+ (json-advance))))
(define-inline json-skip-whitespace ()
"Skip past the whitespace at point."
@@ -213,7 +209,7 @@ Unlike `reverse', this keeps the property-value pairs
intact."
;; https://www.ecma-international.org/publications/files/ECMA-ST/ECMA-404.pdf
;; or https://tools.ietf.org/html/rfc7159#section-2 for the
;; definition of whitespace in JSON.
- (inline-quote (skip-chars-forward "\t\r\n ")))
+ (inline-quote (skip-chars-forward "\t\n\r ")))
@@ -236,8 +232,8 @@ Unlike `reverse', this keeps the property-value pairs
intact."
;;; Paths
(defvar json--path '()
- "Used internally by `json-path-to-position' to keep track of
-the path during recursive calls to `json-read'.")
+ "Keeps track of the path during recursive calls to `json-read'.
+Used internally by `json-path-to-position'.")
(defun json--record-path (key)
"Record the KEY to the current JSON path.
@@ -248,7 +244,7 @@ Used internally by `json-path-to-position'."
"Check if the last parsed JSON structure passed POSITION.
Used internally by `json-path-to-position'."
(let ((start (caar json--path)))
- (when (< start position (+ (point) 1))
+ (when (< start position (1+ (point)))
(throw :json-path (list :path (nreverse (mapcar #'cdr json--path))
:match-start start
:match-end (point)))))
@@ -266,13 +262,13 @@ properties:
:path -- A list of strings and numbers forming the path to
the JSON element at the given position. Strings
denote object names, while numbers denote array
- indexes.
+ indices.
:match-start -- Position where the matched JSON element begins.
:match-end -- Position where the matched JSON element ends.
-This can for instance be useful to determine the path to a JSON
+This can, for instance, be useful to determine the path to a JSON
element in a deeply nested structure."
(save-excursion
(unless string
@@ -280,7 +276,7 @@ element in a deeply nested structure."
(let* ((json--path '())
(json-pre-element-read-function #'json--record-path)
(json-post-element-read-function
- (apply-partially #'json--check-position position))
+ (lambda () (json--check-position position)))
(path (catch :json-path
(if string
(json-read-from-string string)
@@ -290,38 +286,33 @@ element in a deeply nested structure."
;;; Keywords
-(defvar json-keywords '("true" "false" "null")
+(defconst json-keywords '("true" "false" "null")
"List of JSON keywords.")
+(make-obsolete-variable 'json-keywords "it is no longer used." "28.1")
;; Keyword parsing
+;; Characters that can follow a JSON value.
+(rx-define json--post-value (| (in "\t\n\r ,]}") eos))
+
(defun json-read-keyword (keyword)
- "Read a JSON keyword at point.
-KEYWORD is the keyword expected."
- (unless (member keyword json-keywords)
- (signal 'json-unknown-keyword (list keyword)))
- (mapc (lambda (char)
- (when (/= char (json-peek))
- (signal 'json-unknown-keyword
- (list (save-excursion
- (backward-word-strictly 1)
- (thing-at-point 'word)))))
- (json-advance))
- keyword)
- (json-skip-whitespace)
- (unless (looking-at "\\([],}]\\|$\\)")
- (signal 'json-unknown-keyword
- (list (save-excursion
- (backward-word-strictly 1)
- (thing-at-point 'word)))))
- (cond ((string-equal keyword "true") t)
- ((string-equal keyword "false") json-false)
- ((string-equal keyword "null") json-null)))
+ "Read the expected JSON KEYWORD at point."
+ (prog1 (cond ((equal keyword "true") t)
+ ((equal keyword "false") json-false)
+ ((equal keyword "null") json-null)
+ (t (signal 'json-unknown-keyword (list keyword))))
+ (or (looking-at-p keyword)
+ (signal 'json-unknown-keyword (list (thing-at-point 'word))))
+ (json-advance (length keyword))
+ (or (looking-at-p (rx json--post-value))
+ (signal 'json-unknown-keyword (list (thing-at-point 'word))))
+ (json-skip-whitespace)))
;; Keyword encoding
(defun json-encode-keyword (keyword)
"Encode KEYWORD as a JSON value."
+ (declare (side-effect-free t))
(cond ((eq keyword t) "true")
((eq keyword json-false) "false")
((eq keyword json-null) "null")))
@@ -330,37 +321,31 @@ KEYWORD is the keyword expected."
;; Number parsing
-(defun json-read-number (&optional sign)
- "Read the JSON number following point.
-The optional SIGN argument is for internal use.
-
-N.B.: Only numbers which can fit in Emacs Lisp's native number
-representation will be parsed correctly."
- ;; If SIGN is non-nil, the number is explicitly signed.
- (let ((number-regexp
- "\\([0-9]+\\)?\\(\\.[0-9]+\\)?\\([Ee][+-]?[0-9]+\\)?"))
- (cond ((and (null sign) (= (json-peek) ?-))
- (json-advance)
- (- (json-read-number t)))
- ((and (null sign) (= (json-peek) ?+))
- (json-advance)
- (json-read-number t))
- ((and (looking-at number-regexp)
- (or (match-beginning 1)
- (match-beginning 2)))
- (goto-char (match-end 0))
- (string-to-number (match-string 0)))
- (t (signal 'json-number-format (list (point)))))))
+(rx-define json--number
+ (: (? ?-) ; Sign.
+ (| (: (in "1-9") (* digit)) ?0) ; Integer.
+ (? ?. (+ digit)) ; Fraction.
+ (? (in "Ee") (? (in ?+ ?-)) (+ digit)))) ; Exponent.
+
+(defun json-read-number (&optional _sign)
+ "Read the JSON number following point."
+ (declare (advertised-calling-convention () "28.1"))
+ (or (looking-at (rx json--number))
+ (signal 'json-number-format (list (point))))
+ (goto-char (match-end 0))
+ (prog1 (string-to-number (match-string 0))
+ (or (looking-at-p (rx json--post-value))
+ (signal 'json-number-format (list (point))))
+ (json-skip-whitespace)))
;; Number encoding
-(defun json-encode-number (number)
- "Return a JSON representation of NUMBER."
- (format "%s" number))
+(defalias 'json-encode-number #'number-to-string
+ "Return a JSON representation of NUMBER.")
;;; Strings
-(defvar json-special-chars
+(defconst json-special-chars
'((?\" . ?\")
(?\\ . ?\\)
(?b . ?\b)
@@ -368,7 +353,7 @@ representation will be parsed correctly."
(?n . ?\n)
(?r . ?\r)
(?t . ?\t))
- "Characters which are escaped in JSON, with their elisp counterparts.")
+ "Characters which are escaped in JSON, with their Elisp counterparts.")
;; String parsing
@@ -378,48 +363,47 @@ representation will be parsed correctly."
(defun json-read-escaped-char ()
"Read the JSON string escaped character at point."
- ;; Skip over the '\'
+ ;; Skip over the '\'.
(json-advance)
- (let* ((char (json-pop))
- (special (assq char json-special-chars)))
+ (let ((char (json-pop)))
(cond
- (special (cdr special))
- ((not (eq char ?u)) char)
+ ((cdr (assq char json-special-chars)))
+ ((/= char ?u) char)
;; Special-case UTF-16 surrogate pairs,
;; cf. <https://tools.ietf.org/html/rfc7159#section-7>. Note that
;; this clause overlaps with the next one and therefore has to
;; come first.
((looking-at
- (rx (group (any "Dd") (any "89ABab") (= 2 (any xdigit)))
- "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 (any xdigit)))))
+ (rx (group (any "Dd") (any "89ABab") (= 2 xdigit))
+ "\\u" (group (any "Dd") (any "C-Fc-f") (= 2 xdigit))))
(json-advance 10)
(json--decode-utf-16-surrogates
(string-to-number (match-string 1) 16)
(string-to-number (match-string 2) 16)))
((looking-at (rx (= 4 xdigit)))
- (let ((hex (match-string 0)))
- (json-advance 4)
- (string-to-number hex 16)))
+ (json-advance 4)
+ (string-to-number (match-string 0) 16))
(t
(signal 'json-string-escape (list (point)))))))
(defun json-read-string ()
"Read the JSON string at point."
- (unless (= (json-peek) ?\")
- (signal 'json-string-format (list "doesn't start with `\"'!")))
- ;; Skip over the '"'
+ ;; Skip over the '"'.
(json-advance)
(let ((characters '())
(char (json-peek)))
- (while (not (= char ?\"))
+ (while (/= char ?\")
(when (< char 32)
- (signal 'json-string-format (list (prin1-char char))))
+ (if (zerop char)
+ (signal 'json-end-of-file ())
+ (signal 'json-string-format (list char))))
(push (if (= char ?\\)
(json-read-escaped-char)
- (json-pop))
+ (json-advance)
+ char)
characters)
(setq char (json-peek)))
- ;; Skip over the '"'
+ ;; Skip over the '"'.
(json-advance)
(if characters
(concat (nreverse characters))
@@ -427,29 +411,47 @@ representation will be parsed correctly."
;; String encoding
+;; Escape only quotation mark, backslash, and the control
+;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
+(rx-define json--escape (in ?\" ?\\ cntrl))
+
+(defvar json--long-string-threshold 200
+ "Length above which strings are considered long for JSON encoding.
+It is generally faster to manipulate such strings in a buffer
+rather than directly.")
+
+(defvar json--string-buffer nil
+ "Buffer used for encoding Lisp strings as JSON.
+Initialized lazily by `json-encode-string'.")
+
(defun json-encode-string (string)
"Return a JSON representation of STRING."
- ;; Reimplement the meat of `replace-regexp-in-string', for
- ;; performance (bug#20154).
- (let ((l (length string))
- (start 0)
- res mb)
- ;; Only escape quotation mark, backslash and the control
- ;; characters U+0000 to U+001F (RFC 4627, ECMA-404).
- (while (setq mb (string-match "[\"\\[:cntrl:]]" string start))
- (let* ((c (aref string mb))
- (special (rassq c json-special-chars)))
- (push (substring string start mb) res)
- (push (if special
- ;; Special JSON character (\n, \r, etc.).
- (string ?\\ (car special))
- ;; Fallback: UCS code point in \uNNNN form.
- (format "\\u%04x" c))
- res)
- (setq start (1+ mb))))
- (push (substring string start l) res)
- (push "\"" res)
- (apply #'concat "\"" (nreverse res))))
+ ;; Try to avoid buffer overhead in trivial cases, while also
+ ;; avoiding searching pathological strings for escape characters.
+ ;; Since `string-match-p' doesn't take a LIMIT argument, we use
+ ;; string length as our heuristic. See also bug#20154.
+ (if (and (< (length string) json--long-string-threshold)
+ (not (string-match-p (rx json--escape) string)))
+ (concat "\"" string "\"")
+ (with-current-buffer
+ (or json--string-buffer
+ (with-current-buffer (generate-new-buffer " *json-string*")
+ ;; This seems to afford decent performance gains.
+ (setq-local inhibit-modification-hooks t)
+ (setq json--string-buffer (current-buffer))))
+ (insert ?\" string)
+ (goto-char (1+ (point-min)))
+ (while (re-search-forward (rx json--escape) nil 'move)
+ (let ((char (preceding-char)))
+ (delete-char -1)
+ (insert ?\\ (or
+ ;; Special JSON character (\n, \r, etc.).
+ (car (rassq char json-special-chars))
+ ;; Fallback: UCS code point in \uNNNN form.
+ (format "u%04x" char)))))
+ (insert ?\")
+ ;; Empty buffer for next invocation.
+ (delete-and-extract-region (point-min) (point-max)))))
(defun json-encode-key (object)
"Return a JSON representation of OBJECT.
@@ -460,15 +462,13 @@ this signals `json-key-format'."
(signal 'json-key-format (list object)))
encoded))
-;;; JSON Objects
+;;; Objects
(defun json-new-object ()
- "Create a new Elisp object corresponding to a JSON object.
+ "Create a new Elisp object corresponding to an empty JSON object.
Please see the documentation of `json-object-type'."
- (cond ((eq json-object-type 'hash-table)
- (make-hash-table :test 'equal))
- (t
- ())))
+ (and (eq json-object-type 'hash-table)
+ (make-hash-table :test #'equal)))
(defun json-add-to-object (object key value)
"Add a new KEY -> VALUE association to OBJECT.
@@ -476,10 +476,10 @@ Returns the updated object, which you should save, e.g.:
(setq obj (json-add-to-object obj \"foo\" \"bar\"))
Please see the documentation of `json-object-type' and `json-key-type'."
(let ((json-key-type
- (or json-key-type
- (cdr (assq json-object-type '((hash-table . string)
- (alist . symbol)
- (plist . keyword)))))))
+ (cond (json-key-type)
+ ((eq json-object-type 'hash-table) 'string)
+ ((eq json-object-type 'alist) 'symbol)
+ ((eq json-object-type 'plist) 'keyword))))
(setq key
(cond ((eq json-key-type 'string)
key)
@@ -499,13 +499,13 @@ Please see the documentation of `json-object-type' and
`json-key-type'."
(defun json-read-object ()
"Read the JSON object at point."
- ;; Skip over the "{"
+ ;; Skip over the '{'.
(json-advance)
(json-skip-whitespace)
- ;; read key/value pairs until "}"
+ ;; Read key/value pairs until '}'.
(let ((elements (json-new-object))
key value)
- (while (not (= (json-peek) ?}))
+ (while (/= (json-peek) ?\})
(json-skip-whitespace)
(setq key (json-read-string))
(json-skip-whitespace)
@@ -520,94 +520,94 @@ Please see the documentation of `json-object-type' and
`json-key-type'."
(funcall json-post-element-read-function))
(setq elements (json-add-to-object elements key value))
(json-skip-whitespace)
- (when (/= (json-peek) ?})
+ (when (/= (json-peek) ?\})
(if (= (json-peek) ?,)
(json-advance)
(signal 'json-object-format (list "," (json-peek))))))
- ;; Skip over the "}"
+ ;; Skip over the '}'.
(json-advance)
(pcase json-object-type
('alist (nreverse elements))
- ('plist (json--plist-reverse elements))
+ ('plist (json--plist-nreverse elements))
(_ elements))))
;; Hash table encoding
(defun json-encode-hash-table (hash-table)
"Return a JSON representation of HASH-TABLE."
- (if json-encoding-object-sort-predicate
- (json-encode-alist (map-into hash-table 'list))
- (format "{%s%s}"
- (json-join
- (let (r)
- (json--with-indentation
- (maphash
- (lambda (k v)
- (push (format
- (if json-encoding-pretty-print
- "%s%s: %s"
- "%s%s:%s")
- json--encoding-current-indentation
- (json-encode-key k)
- (json-encode v))
- r))
- hash-table))
- r)
- json-encoding-separator)
- (if (or (not json-encoding-pretty-print)
- json-encoding-lisp-style-closings)
- ""
- json--encoding-current-indentation))))
+ (cond ((hash-table-empty-p hash-table) "{}")
+ (json-encoding-object-sort-predicate
+ (json--encode-alist (map-pairs hash-table) t))
+ (t
+ (let ((kv-sep (if json-encoding-pretty-print ": " ":"))
+ result)
+ (json--with-indentation
+ (maphash
+ (lambda (k v)
+ (push (concat json--encoding-current-indentation
+ (json-encode-key k)
+ kv-sep
+ (json-encode v))
+ result))
+ hash-table))
+ (concat "{"
+ (string-join (nreverse result) json-encoding-separator)
+ (and json-encoding-pretty-print
+ (not json-encoding-lisp-style-closings)
+ json--encoding-current-indentation)
+ "}")))))
;; List encoding (including alists and plists)
-(defun json-encode-alist (alist)
- "Return a JSON representation of ALIST."
+(defun json--encode-alist (alist &optional destructive)
+ "Return a JSON representation of ALIST.
+DESTRUCTIVE non-nil means it is safe to modify ALIST by
+side-effects."
(when json-encoding-object-sort-predicate
- (setq alist
- (sort alist (lambda (a b)
+ (setq alist (sort (if destructive alist (copy-sequence alist))
+ (lambda (a b)
(funcall json-encoding-object-sort-predicate
(car a) (car b))))))
- (format "{%s%s}"
- (json-join
- (json--with-indentation
- (mapcar (lambda (cons)
- (format (if json-encoding-pretty-print
- "%s%s: %s"
- "%s%s:%s")
- json--encoding-current-indentation
- (json-encode-key (car cons))
- (json-encode (cdr cons))))
- alist))
- json-encoding-separator)
- (if (or (not json-encoding-pretty-print)
- json-encoding-lisp-style-closings)
- ""
- json--encoding-current-indentation)))
+ (concat "{"
+ (let ((kv-sep (if json-encoding-pretty-print ": " ":")))
+ (json--with-indentation
+ (mapconcat (lambda (cons)
+ (concat json--encoding-current-indentation
+ (json-encode-key (car cons))
+ kv-sep
+ (json-encode (cdr cons))))
+ alist
+ json-encoding-separator)))
+ (and json-encoding-pretty-print
+ (not json-encoding-lisp-style-closings)
+ json--encoding-current-indentation)
+ "}"))
+
+(defun json-encode-alist (alist)
+ "Return a JSON representation of ALIST."
+ (if alist (json--encode-alist alist) "{}"))
(defun json-encode-plist (plist)
"Return a JSON representation of PLIST."
- (if json-encoding-object-sort-predicate
- (json-encode-alist (json--plist-to-alist plist))
- (let (result)
- (json--with-indentation
- (while plist
- (push (concat
- json--encoding-current-indentation
- (json-encode-key (car plist))
- (if json-encoding-pretty-print
- ": "
- ":")
- (json-encode (cadr plist)))
+ (cond ((null plist) "{}")
+ (json-encoding-object-sort-predicate
+ (json--encode-alist (map-pairs plist) t))
+ (t
+ (let ((kv-sep (if json-encoding-pretty-print ": " ":"))
result)
- (setq plist (cddr plist))))
- (concat "{"
- (json-join (nreverse result) json-encoding-separator)
- (if (and json-encoding-pretty-print
- (not json-encoding-lisp-style-closings))
- json--encoding-current-indentation
- "")
- "}"))))
+ (json--with-indentation
+ (while plist
+ (push (concat json--encoding-current-indentation
+ (json-encode-key (pop plist))
+ kv-sep
+ (json-encode (pop plist)))
+ result)))
+ (concat "{"
+ (string-join (nreverse result) json-encoding-separator)
+ (and json-encoding-pretty-print
+ (not json-encoding-lisp-style-closings)
+ json--encoding-current-indentation)
+ "}")))))
(defun json-encode-list (list)
"Return a JSON representation of LIST.
@@ -625,15 +625,17 @@ become JSON objects."
(defun json-read-array ()
"Read the JSON array at point."
- ;; Skip over the "["
+ ;; Skip over the '['.
(json-advance)
(json-skip-whitespace)
- ;; read values until "]"
- (let (elements)
- (while (not (= (json-peek) ?\]))
+ ;; Read values until ']'.
+ (let (elements
+ (len 0))
+ (while (/= (json-peek) ?\])
(json-skip-whitespace)
(when json-pre-element-read-function
- (funcall json-pre-element-read-function (length elements)))
+ (funcall json-pre-element-read-function len)
+ (setq len (1+ len)))
(push (json-read) elements)
(when json-post-element-read-function
(funcall json-post-element-read-function))
@@ -641,8 +643,8 @@ become JSON objects."
(when (/= (json-peek) ?\])
(if (= (json-peek) ?,)
(json-advance)
- (signal 'json-array-format (list ?, (json-peek))))))
- ;; Skip over the "]"
+ (signal 'json-array-format (list "," (json-peek))))))
+ ;; Skip over the ']'.
(json-advance)
(pcase json-array-type
('vector (nreverse (vconcat elements)))
@@ -653,42 +655,43 @@ become JSON objects."
(defun json-encode-array (array)
"Return a JSON representation of ARRAY."
(if (and json-encoding-pretty-print
- (> (length array) 0))
+ (not (seq-empty-p array)))
(concat
+ "["
(json--with-indentation
- (concat (format "[%s" json--encoding-current-indentation)
- (json-join (mapcar 'json-encode array)
- (format "%s%s"
- json-encoding-separator
+ (concat json--encoding-current-indentation
+ (mapconcat #'json-encode array
+ (concat json-encoding-separator
json--encoding-current-indentation))))
- (format "%s]"
- (if json-encoding-lisp-style-closings
- ""
- json--encoding-current-indentation)))
+ (unless json-encoding-lisp-style-closings
+ json--encoding-current-indentation)
+ "]")
(concat "["
- (mapconcat 'json-encode array json-encoding-separator)
+ (mapconcat #'json-encode array json-encoding-separator)
"]")))
-;;; JSON reader.
+;;; Reader
(defmacro json-readtable-dispatch (char)
- "Dispatch reader function for CHAR."
- (declare (debug (symbolp)))
- (let ((table
- '((?t json-read-keyword "true")
- (?f json-read-keyword "false")
- (?n json-read-keyword "null")
- (?{ json-read-object)
- (?\[ json-read-array)
- (?\" json-read-string)))
- res)
- (dolist (c '(?- ?+ ?. ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
- (push (list c 'json-read-number) table))
- (pcase-dolist (`(,c . ,rest) table)
- (push `((eq ,char ,c) (,@rest)) res))
- `(cond ,@res (t (signal 'json-readtable-error (list ,char))))))
+ "Dispatch reader function for CHAR at point.
+If CHAR is nil, signal `json-end-of-file'."
+ (declare (debug t))
+ (macroexp-let2 nil char char
+ `(cond ,@(map-apply
+ (lambda (key expr)
+ `((eq ,char ,key) ,expr))
+ `((?\" ,#'json-read-string)
+ (?\[ ,#'json-read-array)
+ (?\{ ,#'json-read-object)
+ (?n ,#'json-read-keyword "null")
+ (?f ,#'json-read-keyword "false")
+ (?t ,#'json-read-keyword "true")
+ ,@(mapcar (lambda (c) (list c #'json-read-number))
+ '(?- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))))
+ (,char (signal 'json-readtable-error (list ,char)))
+ (t (signal 'json-end-of-file ())))))
(defun json-read ()
"Parse and return the JSON object following point.
@@ -706,10 +709,7 @@ you will get the following structure returned:
((c . :json-false))])
(b . \"foo\"))"
(json-skip-whitespace)
- (let ((char (json-peek)))
- (if (zerop char)
- (signal 'json-end-of-file nil)
- (json-readtable-dispatch char))))
+ (json-readtable-dispatch (char-after)))
;; Syntactic sugar for the reader
@@ -724,12 +724,11 @@ you will get the following structure returned:
"Read the first JSON object contained in FILE and return it."
(with-temp-buffer
(insert-file-contents file)
- (goto-char (point-min))
(json-read)))
-;;; JSON encoder
+;;; Encoder
(defun json-encode (object)
"Return a JSON representation of OBJECT as a string.
@@ -737,20 +736,21 @@ you will get the following structure returned:
OBJECT should have a structure like one returned by `json-read'.
If an error is detected during encoding, an error based on
`json-error' is signaled."
- (cond ((memq object (list t json-null json-false))
- (json-encode-keyword object))
- ((stringp object) (json-encode-string object))
- ((keywordp object) (json-encode-string
- (substring (symbol-name object) 1)))
- ((listp object) (json-encode-list object))
- ((symbolp object) (json-encode-string
- (symbol-name object)))
- ((numberp object) (json-encode-number object))
- ((arrayp object) (json-encode-array object))
- ((hash-table-p object) (json-encode-hash-table object))
- (t (signal 'json-error (list object)))))
-
-;; Pretty printing & minimizing
+ (cond ((eq object t) (json-encode-keyword object))
+ ((eq object json-null) (json-encode-keyword object))
+ ((eq object json-false) (json-encode-keyword object))
+ ((stringp object) (json-encode-string object))
+ ((keywordp object) (json-encode-string
+ (substring (symbol-name object) 1)))
+ ((listp object) (json-encode-list object))
+ ((symbolp object) (json-encode-string
+ (symbol-name object)))
+ ((numberp object) (json-encode-number object))
+ ((arrayp object) (json-encode-array object))
+ ((hash-table-p object) (json-encode-hash-table object))
+ (t (signal 'json-error (list object)))))
+
+;;; Pretty printing & minimizing
(defun json-pretty-print-buffer (&optional minimize)
"Pretty-print current buffer.
@@ -769,9 +769,9 @@ MAX-SECS.")
With prefix argument MINIMIZE, minimize it instead."
(interactive "r\nP")
(let ((json-encoding-pretty-print (null minimize))
- ;; Distinguish an empty objects from 'null'
+ ;; Distinguish an empty object from 'null'.
(json-null :json-null)
- ;; Ensure that ordering is maintained
+ ;; Ensure that ordering is maintained.
(json-object-type 'alist)
(orig-buf (current-buffer))
error)
@@ -800,9 +800,7 @@ With prefix argument MINIMIZE, minimize it instead."
;; them.
(let ((space (buffer-substring
(point)
- (+ (point)
- (skip-chars-forward
- " \t\n" (point-max)))))
+ (+ (point) (skip-chars-forward " \t\n"))))
(json (json-read)))
(setq pos (point)) ; End of last good json-read.
(set-buffer tmp-buf)
@@ -832,14 +830,14 @@ With prefix argument MINIMIZE, minimize it instead."
"Pretty-print current buffer with object keys ordered.
With prefix argument MINIMIZE, minimize it instead."
(interactive "P")
- (let ((json-encoding-object-sort-predicate 'string<))
+ (let ((json-encoding-object-sort-predicate #'string<))
(json-pretty-print-buffer minimize)))
(defun json-pretty-print-ordered (begin end &optional minimize)
"Pretty-print the region with object keys ordered.
With prefix argument MINIMIZE, minimize it instead."
(interactive "r\nP")
- (let ((json-encoding-object-sort-predicate 'string<))
+ (let ((json-encoding-object-sort-predicate #'string<))
(json-pretty-print begin end minimize)))
(provide 'json)
diff --git a/lisp/jsonrpc.el b/lisp/jsonrpc.el
index 65c0df8..42e7701 100644
--- a/lisp/jsonrpc.el
+++ b/lisp/jsonrpc.el
@@ -4,11 +4,11 @@
;; Author: João Távora <joaotavora@gmail.com>
;; Keywords: processes, languages, extensions
+;; Version: 1.0.11
;; Package-Requires: ((emacs "25.2"))
-;; Version: 1.0.9
-;; This is an Elpa :core package. Don't use functionality that is not
-;; compatible with Emacs 25.2.
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -37,7 +37,6 @@
;;; Code:
(require 'cl-lib)
-(require 'json)
(require 'eieio)
(eval-when-compile (require 'subr-x))
(require 'warnings)
@@ -364,21 +363,49 @@ connection object, called when the process dies .")
(cl-defmethod initialize-instance ((conn jsonrpc-process-connection) slots)
(cl-call-next-method)
- (let* ((proc (plist-get slots :process))
- (proc (if (functionp proc) (funcall proc) proc))
- (buffer (get-buffer-create (format "*%s output*" (process-name
proc))))
- (stderr (get-buffer-create (format "*%s stderr*" (process-name
proc)))))
+ (cl-destructuring-bind (&key ((:process proc)) name &allow-other-keys) slots
+ ;; FIXME: notice the undocumented bad coupling in the buffer name.
+ ;; The client making the process _must_ use a buffer named exactly
+ ;; like this property when calling `make-process'. If there were
+ ;; a `set-process-stderr' like there is `set-process-buffer' we
+ ;; wouldn't need this and could use a pipe with a process filter
+ ;; instead of `after-change-functions'. Alternatively, we need a
+ ;; new initarg (but maybe not a slot).
+ (with-current-buffer (get-buffer-create (format "*%s stderr*" name))
+ (let ((inhibit-read-only t)
+ (hidden-name (concat " " (buffer-name))))
+ (erase-buffer)
+ (buffer-disable-undo)
+ (add-hook
+ 'after-change-functions
+ (lambda (beg _end _pre-change-len)
+ (cl-loop initially (goto-char beg)
+ do (forward-line)
+ when (bolp)
+ for line = (buffer-substring
+ (line-beginning-position 0)
+ (line-end-position 0))
+ do (with-current-buffer (jsonrpc-events-buffer conn)
+ (goto-char (point-max))
+ (let ((inhibit-read-only t))
+ (insert (format "[stderr] %s\n" line))))
+ until (eobp)))
+ nil t)
+ ;; If we are correctly coupled to the client, it should pick up
+ ;; the current buffer immediately.
+ (setq proc (if (functionp proc) (funcall proc) proc))
+ (ignore-errors (kill-buffer hidden-name))
+ (rename-buffer hidden-name)
+ (process-put proc 'jsonrpc-stderr (current-buffer))
+ (read-only-mode t)))
(setf (jsonrpc--process conn) proc)
- (set-process-buffer proc buffer)
- (process-put proc 'jsonrpc-stderr stderr)
+ (set-process-buffer proc (get-buffer-create (format " *%s output*" name)))
(set-process-filter proc #'jsonrpc--process-filter)
(set-process-sentinel proc #'jsonrpc--process-sentinel)
(with-current-buffer (process-buffer proc)
(buffer-disable-undo)
(set-marker (process-mark proc) (point-min))
- (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t) proc))
- (with-current-buffer stderr
- (buffer-disable-undo))
+ (let ((inhibit-read-only t)) (erase-buffer) (read-only-mode t)))
(process-put proc 'jsonrpc-connection conn)))
(cl-defmethod jsonrpc-connection-send ((connection jsonrpc-process-connection)
@@ -442,26 +469,35 @@ With optional CLEANUP, kill any associated buffers."
;;;
(define-error 'jsonrpc-error "jsonrpc-error")
-(defun jsonrpc--json-read ()
- "Read JSON object in buffer, move point to end of buffer."
- ;; TODO: I guess we can make these macros if/when jsonrpc.el
- ;; goes into Emacs core.
- (cond ((fboundp 'json-parse-buffer) (json-parse-buffer
- :object-type 'plist
- :null-object nil
- :false-object :json-false))
- (t (let ((json-object-type 'plist))
- (json-read)))))
-
-(defun jsonrpc--json-encode (object)
- "Encode OBJECT into a JSON string."
- (cond ((fboundp 'json-serialize) (json-serialize
- object
- :false-object :json-false
- :null-object nil))
- (t (let ((json-false :json-false)
- (json-null nil))
- (json-encode object)))))
+(defalias 'jsonrpc--json-read
+ (if (fboundp 'json-parse-buffer)
+ (lambda ()
+ (json-parse-buffer :object-type 'plist
+ :null-object nil
+ :false-object :json-false))
+ (require 'json)
+ (defvar json-object-type)
+ (declare-function json-read "json" ())
+ (lambda ()
+ (let ((json-object-type 'plist))
+ (json-read))))
+ "Read JSON object in buffer, move point to end of buffer.")
+
+(defalias 'jsonrpc--json-encode
+ (if (fboundp 'json-serialize)
+ (lambda (object)
+ (json-serialize object
+ :false-object :json-false
+ :null-object nil))
+ (require 'json)
+ (defvar json-false)
+ (defvar json-null)
+ (declare-function json-encode "json" (object))
+ (lambda (object)
+ (let ((json-false :json-false)
+ (json-null nil))
+ (json-encode object))))
+ "Encode OBJECT into a JSON string.")
(cl-defun jsonrpc--reply
(connection id &key (result nil result-supplied-p) (error nil
error-supplied-p))
@@ -682,7 +718,7 @@ originated."
(format "-%s" subtype)))))
(goto-char (point-max))
(prog1
- (let ((msg (format "%s%s%s %s:\n%s\n"
+ (let ((msg (format "[%s]%s%s %s:\n%s"
type
(if id (format " (id:%s)" id) "")
(if error " ERROR" "")
diff --git a/lisp/language/japanese.el b/lisp/language/japanese.el
index d77efa4..9a99245 100644
--- a/lisp/language/japanese.el
+++ b/lisp/language/japanese.el
@@ -82,9 +82,7 @@
(#x00A6 . #xFFE4) ; BROKEN LINE FULLWIDTH BROKEN LINE
)))
(define-translation-table 'japanese-ucs-jis-to-cp932-map map)
- (mapc #'(lambda (x) (let ((tmp (car x)))
- (setcar x (cdr x)) (setcdr x tmp)))
- map)
+ (setq map (mapcar (lambda (x) (cons (cdr x) (car x))) map))
(define-translation-table 'japanese-ucs-cp932-to-jis-map map))
;; U+2014 (EM DASH) vs U+2015 (HORIZONTAL BAR)
@@ -241,8 +239,10 @@ eucJP-ms is defined in
<http://www.opengroup.or.jp/jvc/cde/appendix.html>."
(#x2b65 . [#x02E9 #x02E5])
(#x2b66 . [#x02E5 #x02E9])))
table)
- (dolist (elt map)
- (setcar elt (decode-char 'japanese-jisx0213-1 (car elt))))
+ (setq map
+ (mapcar (lambda (x) (cons (decode-char 'japanese-jisx0213-1 (car x))
+ (cdr x)))
+ map))
(setq table (make-translation-table-from-alist map))
(define-translation-table 'jisx0213-to-unicode table)
(define-translation-table 'unicode-to-jisx0213
diff --git a/lisp/language/lao-util.el b/lisp/language/lao-util.el
index a20aece..fa4c2f7 100644
--- a/lisp/language/lao-util.el
+++ b/lisp/language/lao-util.el
@@ -183,7 +183,9 @@
;; Semi-vowel-sign-lo and lower vowels are put under the letter.
(defconst lao-transcription-consonant-alist
- (sort '(;; single consonants
+ (sort
+ (copy-sequence
+ '(;; single consonants
("k" . "ກ")
("kh" . "ຂ")
("qh" . "ຄ")
@@ -223,14 +225,16 @@
("hy" . ["ຫຍ"])
("hn" . ["ຫນ"])
("hm" . ["ຫມ"])
- )
- (function (lambda (x y) (> (length (car x)) (length (car y)))))))
+ ))
+ (lambda (x y) (> (length (car x)) (length (car y))))))
(defconst lao-transcription-semi-vowel-alist
'(("r" . "ຼ")))
(defconst lao-transcription-vowel-alist
- (sort '(("a" . "ະ")
+ (sort
+ (copy-sequence
+ '(("a" . "ະ")
("ar" . "າ")
("i" . "ິ")
("ii" . "ີ")
@@ -257,8 +261,8 @@
("ai" . "ໄ")
("ei" . "ໃ")
("ao" . ["ເົາ"])
- ("aM" . "ຳ"))
- (function (lambda (x y) (> (length (car x)) (length (car y)))))))
+ ("aM" . "ຳ")))
+ (lambda (x y) (> (length (car x)) (length (car y))))))
;; Maa-sakod is put at the tail.
(defconst lao-transcription-maa-sakod-alist
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index 29fff91..8684cdb 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -43,13 +43,17 @@
("་" . "་")
("༔" . "༔")
;; Yes these are dirty. But ...
- ("༎ ༎" . ,(compose-string "༎ ༎" 0 3 [?༎ (Br . Bl) ? (Br . Bl) ?༎]))
+ ("༎ ༎" . ,(compose-string (copy-sequence "༎ ༎")
+ 0 3 [?༎ (Br . Bl) ? (Br . Bl) ?༎]))
("༄༅༅" . ,(compose-string
- "࿁࿂࿂࿂" 0 4
+ (copy-sequence "࿁࿂࿂࿂") 0 4
[?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂ (Br . Bl) ?࿂]))
- ("༄༅" . ,(compose-string "࿁࿂࿂" 0 3 [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂]))
- ("༆" . ,(compose-string "࿁࿂༙" 0 3 [?࿁ (Br . Bl) ?࿂ (br . tr) ?༙]))
- ("༄" . ,(compose-string "࿁࿂" 0 2 [?࿁ (Br . Bl) ?࿂]))))
+ ("༄༅" . ,(compose-string (copy-sequence "࿁࿂࿂")
+ 0 3 [?࿁ (Br . Bl) ?࿂ (Br . Bl) ?࿂]))
+ ("༆" . ,(compose-string (copy-sequence "࿁࿂༙")
+ 0 3 [?࿁ (Br . Bl) ?࿂ (br . tr) ?༙]))
+ ("༄" . ,(compose-string (copy-sequence "࿁࿂")
+ 0 2 [?࿁ (Br . Bl) ?࿂]))))
;;;###autoload
(defun tibetan-char-p (ch)
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index d31cd5c..bbd4729 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -326,7 +326,9 @@
(defconst tibetan-subjoined-transcription-alist
- (sort '(("+k" . "ྐ")
+ (sort
+ (copy-sequence
+ '(("+k" . "ྐ")
("+kh" . "ྑ")
("+g" . "ྒ")
("+gh" . "ྒྷ")
@@ -371,8 +373,8 @@
("+W" . "ྺ") ;; fixed form subscribed WA
("+Y" . "ྻ") ;; fixed form subscribed YA
("+R" . "ྼ") ;; fixed form subscribed RA
- )
- (lambda (x y) (> (length (car x)) (length (car y))))))
+ ))
+ (lambda (x y) (> (length (car x)) (length (car y))))))
;;;
;;; alist for Tibetan base consonant <-> subjoined consonant conversion.
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index e1f238c..d49c752 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -1076,7 +1076,7 @@ search for matches for any two (or more) of those words.
With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil,
consider all symbols (if they match PATTERN).
-Returns list of symbols and documentation found.
+Return list of symbols and documentation found.
\(fn PATTERN &optional DO-ALL)" t nil)
@@ -4745,6 +4745,34 @@ and runs the normal hook `command-history-hook'." t nil)
;;;***
+;;;### (autoloads nil "cl-font-lock" "progmodes/cl-font-lock.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from progmodes/cl-font-lock.el
+
+(defvar cl-font-lock-built-in-mode nil "\
+Non-nil if Cl-Font-Lock-Built-In mode is enabled.
+See the `cl-font-lock-built-in-mode' command
+for a description of this minor mode.
+Setting this variable directly does not take effect;
+either customize it (see the info node `Easy Customization')
+or call the function `cl-font-lock-built-in-mode'.")
+
+(custom-autoload 'cl-font-lock-built-in-mode "cl-font-lock" nil)
+
+(autoload 'cl-font-lock-built-in-mode "cl-font-lock" "\
+Highlight built-in functions, variables, and types in `lisp-mode'.
+
+If called interactively, enable Cl-Font-Lock-Built-In mode if ARG is
+positive, and disable it if ARG is zero or negative. If called from
+Lisp, also enable the mode if ARG is omitted or nil, and toggle it if
+ARG is `toggle'; disable the mode otherwise.
+
+\(fn &optional ARG)" t nil)
+
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"cl-font-lock" '("cl-font-lock-")))
+
+;;;***
+
;;;### (autoloads nil "cl-generic" "emacs-lisp/cl-generic.el" (0
;;;;;; 0 0 0))
;;; Generated autoloads from emacs-lisp/cl-generic.el
@@ -12751,6 +12779,13 @@ Interactively, prompt for LIBRARY using the one at or
near point.
\(fn LIBRARY)" t nil)
+(autoload 'read-library-name "find-func" "\
+Read and return a library name, defaulting to the one near point.
+
+A library name is the filename of an Emacs Lisp library located
+in a directory under `load-path' (or `find-function-source-path',
+if non-nil)." nil nil)
+
(autoload 'find-library-other-window "find-func" "\
Find the Emacs Lisp source of LIBRARY in another window.
@@ -12918,7 +12953,7 @@ Find directly the variable at point in the other
window." t nil)
(autoload 'find-function-setup-keys "find-func" "\
Define some key bindings for the find-function family of functions." nil nil)
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"find-func" '("find-" "read-library-name")))
+(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"find-func" '("find-")))
;;;***
@@ -15360,9 +15395,13 @@ arguments as NAME. DO is a function as defined in
`gv-get'.
\(fn SYMBOL NAME ARGS HANDLER &optional FIX)" nil nil)
-(or (assq 'gv-expander defun-declarations-alist) (let ((x `(gv-expander
,(apply-partially #'gv--defun-declaration 'gv-expander)))) (push x
macro-declarations-alist) (push x defun-declarations-alist)))
+(defsubst gv--expander-defun-declaration (&rest args) (apply
#'gv--defun-declaration 'gv-expander args))
+
+(defsubst gv--setter-defun-declaration (&rest args) (apply
#'gv--defun-declaration 'gv-setter args))
+
+(or (assq 'gv-expander defun-declarations-alist) (let ((x (list 'gv-expander
#'gv--expander-defun-declaration))) (push x macro-declarations-alist) (push x
defun-declarations-alist)))
-(or (assq 'gv-setter defun-declarations-alist) (push `(gv-setter
,(apply-partially #'gv--defun-declaration 'gv-setter))
defun-declarations-alist))
+(or (assq 'gv-setter defun-declarations-alist) (push (list 'gv-setter
#'gv--setter-defun-declaration) defun-declarations-alist))
(autoload 'gv-define-setter "gv" "\
Define a setter method for generalized variable NAME.
@@ -16100,6 +16139,9 @@ of text in those lines.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type.
@@ -16115,11 +16157,18 @@ Use the global history list for FACE. Limit face
setting to the
corresponding SUBEXP (interactively, the prefix argument) of REGEXP.
If SUBEXP is omitted or nil, the entire REGEXP is highlighted.
+LIGHTER is a human-readable string that can be used to select
+a regexp to unhighlight by its name instead of selecting a possibly
+complex regexp or closure.
+
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
highlighting will not update as you type.
-\(fn REGEXP &optional FACE SUBEXP)" t nil)
+\(fn REGEXP &optional FACE SUBEXP LIGHTER)" t nil)
(defalias 'highlight-phrase 'hi-lock-face-phrase-buffer)
@@ -16128,9 +16177,9 @@ Set face of each match of phrase REGEXP to FACE.
Interactively, prompt for REGEXP using `read-regexp', then FACE.
Use the global history list for FACE.
-When called interactively, replace whitespace in user-provided
-regexp with arbitrary whitespace, and make initial lower-case
-letters case-insensitive, before highlighting with `hi-lock-set-pattern'.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+Also set `search-spaces-regexp' to the value of `search-whitespace-regexp'.
Use Font lock mode, if enabled, to highlight REGEXP. Otherwise,
use overlays for highlighting. If overlays are used, the
@@ -16146,6 +16195,9 @@ Uses the next face from `hi-lock-face-defaults' without
prompting,
unless you use a prefix argument.
Uses `find-tag-default-as-symbol-regexp' to retrieve the symbol at point.
+If REGEXP contains upper case characters (excluding those preceded by `\\')
+and `search-upper-case' is non-nil, the matching is case-sensitive.
+
This uses Font lock mode if it is enabled; otherwise it uses overlays,
in which case the highlighting will not update as you type." t nil)
@@ -18821,8 +18873,8 @@ Check comments and strings in the current buffer for
spelling errors." t nil)
Check the current buffer for spelling errors interactively." t nil)
(autoload 'ispell-buffer-with-debug "ispell" "\
-`ispell-buffer' with some output sent to `ispell-debug-buffer' buffer.
-If APPEND is non-n il, append the info to previous buffer if exists.
+`ispell-buffer' with some output sent to `ispell-debug-buffer'.
+If APPEND is non-nil, don't erase previous debugging output.
\(fn &optional APPEND)" t nil)
@@ -21853,7 +21905,7 @@ unless the display width of STR is equal to or less
than the display
width of ELLIPSIS. If it is non-nil and not a string, then ELLIPSIS
defaults to `truncate-string-ellipsis'.
-If ELLIPSIS-TEXT-PROPERTY in non-nil, a too-long string will not
+If ELLIPSIS-TEXT-PROPERTY is non-nil, a too-long string will not
be truncated, but instead the elided parts will be covered by a
`display' text property showing the ellipsis.
@@ -22162,6 +22214,10 @@ values:
`ssl' -- Equivalent to `tls'.
`shell' -- A shell connection.
+:coding is a symbol or a cons used to specify the coding systems
+used to decode and encode the data which the process reads and
+writes. See `make-network-process' for details.
+
:return-list specifies this function's return value.
If omitted or nil, return a process object. A non-nil means to
return (PROC . PROPS), where PROC is a process object and PROPS
@@ -30984,7 +31040,8 @@ as start and end positions), and with `string<'
otherwise.
\(fn REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN PREDICATE)"
nil nil)
(autoload 'sort-lines "sort" "\
-Sort lines in region alphabetically; argument means descending order.
+Sort lines in region alphabetically; REVERSE non-nil means descending order.
+Interactively, REVERSE is the prefix argument, and BEG and END are the region.
Called from a program, there are three arguments:
REVERSE (non-nil means reverse order), BEG and END (region to sort).
The variable `sort-fold-case' determines whether alphabetic case affects
@@ -32064,6 +32121,11 @@ The variable list SPEC is the same as in `if-let'.
(function-put 'when-let 'lisp-indent-function '1)
+(autoload 'string-truncate-left "subr-x" "\
+Truncate STRING to LENGTH, replacing initial surplus with \"...\".
+
+\(fn STRING LENGTH)" nil nil)
+
(if (fboundp 'register-definition-prefixes) (register-definition-prefixes
"subr-x" '("and-let*" "hash-table-" "if-let" "internal--"
"replace-region-contents" "string-" "thread-" "when-let*")))
;;;***
@@ -34460,7 +34522,9 @@ You can call this function to add internal values in
the trace buffer.
(autoload 'trace-function-foreground "trace" "\
Trace calls to function FUNCTION.
With a prefix argument, also prompt for the trace buffer (default
-`trace-buffer'), and a Lisp expression CONTEXT.
+`trace-buffer'), and a Lisp expression CONTEXT. When called from
+Lisp, CONTEXT should be a function of no arguments which returns
+a value to insert into BUFFER during the trace.
Tracing a function causes every call to that function to insert
into BUFFER Lisp-style trace messages that display the function's
diff --git a/lisp/mail/qp.el b/lisp/mail/qp.el
index 388c398..35ff47f 100644
--- a/lisp/mail/qp.el
+++ b/lisp/mail/qp.el
@@ -1,4 +1,4 @@
-;;; qp.el --- Quoted-Printable functions
+;;; qp.el --- Quoted-Printable functions -*- lexical-binding:t -*-
;; Copyright (C) 1998-2020 Free Software Foundation, Inc.
diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el
index 7b38288..afa3059 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/mail/rfc2368.el
@@ -1,4 +1,4 @@
-;;; rfc2368.el --- support for rfc2368
+;;; rfc2368.el --- support for rfc2368 -*- lexical-binding:t -*-
;; Copyright (C) 1998, 2000-2020 Free Software Foundation, Inc.
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index 731da19..9bc667a 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -1085,10 +1085,10 @@ The selected font will be the default on both the
existing and future frames."
:visible (display-graphic-p)
:button
(:radio . (and tool-bar-mode
- (frame-parameter
+ (eq (frame-parameter
(menu-bar-frame-for-menubar)
'tool-bar-position)
- 'left))))
+ 'left)))))
(bindings--define-key menu [showhide-tool-bar-right]
'(menu-item "On the Right"
diff --git a/lisp/mouse.el b/lisp/mouse.el
index 9703d95..640f10a 100644
--- a/lisp/mouse.el
+++ b/lisp/mouse.el
@@ -2556,7 +2556,7 @@ region, text is copied instead of being cut."
(lambda (modifier)
`(const :tag ,(format "Enable, but copy with the %s modifier"
modifier)
- modifier))
+ ,modifier))
'(alt super hyper shift control meta))
(other :tag "Enable dragging the region" t))
:version "26.1")
@@ -2575,9 +2575,12 @@ as it does when dropping text in the source buffer."
If this option is nil, `mouse-drag-and-drop-region' does not show
tooltips. If this is t, it shows the entire text dragged in a
tooltip. If this is an integer (as with the default value of
-256), it will show that many characters of the dragged text in
-a tooltip."
- :type 'integer
+256), it will show up to that many characters of the dragged text
+in a tooltip."
+ :type '(choice
+ (const :tag "Do not show tooltips" nil)
+ (const :tag "Show all text" t)
+ (integer :tag "Max number of characters to show" 256))
:version "26.1")
(defcustom mouse-drag-and-drop-region-show-cursor t
@@ -2611,6 +2614,7 @@ is copied instead of being cut."
(let* ((mouse-button (event-basic-type last-input-event))
(mouse-drag-and-drop-region-show-tooltip
(when (and mouse-drag-and-drop-region-show-tooltip
+ (> mouse-drag-and-drop-region-show-tooltip 0)
(display-multi-frame-p)
(require 'tooltip))
mouse-drag-and-drop-region-show-tooltip))
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 7aad44b..8892e80 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -39,7 +39,6 @@
;; browse-url-chrome Chrome 47.0.2526.111
;; browse-url-chromium Chromium 3.0
;; browse-url-epiphany Epiphany Don't know
-;; browse-url-conkeror Conkeror Don't know
;; browse-url-w3 w3 0
;; browse-url-text-* Any text browser 0
;; browse-url-generic arbitrary
@@ -114,9 +113,23 @@
;; To always save modified buffers before displaying the file in a browser:
;; (setq browse-url-save-file t)
-;; To invoke different browsers for different URLs:
-;; (setq browse-url-browser-function '(("^mailto:"; . browse-url-mail)
-;; ("." . browse-url-firefox)))
+;; To invoke different browsers/tools for different URLs, customize
+;; `browse-url-handlers'. In earlier versions of Emacs, the same
+;; could be done by setting `browse-url-browser-function' to an alist
+;; but this usage is deprecated now.
+
+;; All browser functions provided by here have a
+;; `browse-url-browser-kind' symbol property set to either `internal'
+;; or `external' which determines if they browse the given URL inside
+;; Emacs or spawn an external application with it. Some parts of
+;; Emacs make use of that, e.g., when an URL is dragged into Emacs, it
+;; is not sensible to invoke an external browser with it, so here only
+;; internal browsers are considered. Therefore, it is advised to put
+;; that property also on custom browser functions.
+;; (function-put 'my-browse-url-in-emacs 'browse-url-browser-kind
+;; 'internal)
+;; (function-put 'my-browse-url-externally 'browse-url-browser-kind
+;; 'external)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Code:
@@ -140,7 +153,6 @@
(function-item :tag "Google Chrome" :value browse-url-chrome)
(function-item :tag "Chromium" :value browse-url-chromium)
(function-item :tag "Epiphany" :value browse-url-epiphany)
- (function-item :tag "Conkeror" :value browse-url-conkeror)
(function-item :tag "Text browser in an xterm window"
:value browse-url-text-xterm)
(function-item :tag "Text browser in an Emacs window"
@@ -157,7 +169,9 @@
:value browse-url-default-browser)
(function :tag "Your own function")
(alist :tag "Regexp/function association list"
- :key-type regexp :value-type function)))
+ :key-type regexp :value-type function
+ :format "%{%t%}\n%d%v\n"
+ :doc "Deprecated. Use `browse-url-handlers' instead.")))
;;;###autoload
(defcustom browse-url-browser-function 'browse-url-default-browser
@@ -165,13 +179,8 @@
This is used by the `browse-url-at-point', `browse-url-at-mouse', and
`browse-url-of-file' commands.
-If the value is not a function it should be a list of pairs
-\(REGEXP . FUNCTION). In this case the function called will be the one
-associated with the first REGEXP which matches the current URL. The
-function is passed the URL and any other args of `browse-url'. The last
-regexp should probably be \".\" to specify a default browser.
-
-Also see `browse-url-secondary-browser-function'."
+Also see `browse-url-secondary-browser-function' and
+`browse-url-handlers'."
:type browse-url--browser-defcustom-type
:version "24.1")
@@ -385,6 +394,8 @@ If non-nil, then open the URL in a new buffer rather than a
new window if
:version "25.1"
:type 'boolean)
+(make-obsolete-variable 'browse-url-conkeror-new-window-is-buffer nil "28.1")
+
(defcustom browse-url-galeon-new-window-is-tab nil
"Whether to open up new windows in a tab or a new window.
If non-nil, then open the URL in a new tab rather than a new window if
@@ -438,11 +449,15 @@ commands reverses the effect of this variable."
:type 'string
:version "25.1")
+(make-obsolete-variable 'browse-url-conkeror-program nil "28.1")
+
(defcustom browse-url-conkeror-arguments nil
"A list of strings to pass to Conkeror as arguments."
:version "25.1"
:type '(repeat (string :tag "Argument")))
+(make-obsolete-variable 'browse-url-conkeror-arguments nil "28.1")
+
(defcustom browse-url-filename-alist
`(("^/\\(ftp@\\|anonymous@\\)?\\([^:/]+\\):/*" . "ftp://\\2/";)
;; The above loses the username to avoid the browser prompting for
@@ -595,6 +610,116 @@ down (this *won't* always work)."
"Wrapper command prepended to the Elinks command-line."
:type '(repeat (string :tag "Wrapper")))
+(defun browse-url--browser-kind (function url)
+ "Return the browser kind of a browser FUNCTION for URL.
+The browser kind is either `internal' (the browser runs inside
+Emacs), `external' (the browser is spawned in an external
+process), or nil (we don't know)."
+ (let ((kind (if (symbolp function)
+ (get function 'browse-url-browser-kind))))
+ (if (functionp kind)
+ (funcall kind url)
+ kind)))
+
+(defun browse-url--mailto (url &rest args)
+ "Calls `browse-url-mailto-function' with URL and ARGS."
+ (funcall browse-url-mailto-function url args))
+
+(defun browse-url--browser-kind-mailto (url)
+ (browse-url--browser-kind browse-url-mailto-function url))
+(function-put 'browse-url--mailto 'browse-url-browser-kind
+ #'browse-url--browser-kind-mailto)
+
+(defun browse-url--man (url &rest args)
+ "Calls `browse-url-man-function' with URL and ARGS."
+ (funcall browse-url-man-function url args))
+
+(defun browse-url--browser-kind-man (url)
+ (browse-url--browser-kind browse-url-man-function url))
+(function-put 'browse-url--man 'browse-url-browser-kind
+ #'browse-url--browser-kind-man)
+
+(defun browse-url--browser (url &rest args)
+ "Calls `browse-url-browser-function' with URL and ARGS."
+ (funcall browse-url-browser-function url args))
+
+(defun browse-url--browser-kind-browser (url)
+ (browse-url--browser-kind browse-url-browser-function url))
+(function-put 'browse-url--browser 'browse-url-browser-kind
+ #'browse-url--browser-kind-browser)
+
+(defun browse-url--non-html-file-url-p (url)
+ "Return non-nil if URL is a file:// URL of a non-HTML file."
+ (and (string-match-p "\\`file://" url)
+ (not (string-match-p "\\`file://.*\\.html?\\b" url))))
+
+;;;###autoload
+(defvar browse-url-default-handlers
+ '(("\\`mailto:"; . browse-url--mailto)
+ ("\\`man:" . browse-url--man)
+ (browse-url--non-html-file-url-p . browse-url-emacs))
+ "Like `browse-url-handlers' but populated by Emacs and packages.
+
+Emacs and external packages capable of browsing certain URLs
+should place their entries in this alist rather than
+`browse-url-handlers' which is reserved for the user.")
+
+(defcustom browse-url-handlers nil
+ "An alist with elements of the form (REGEXP-OR-PREDICATE . HANDLER).
+Each REGEXP-OR-PREDICATE is matched against the URL to be opened
+in turn and the first match's HANDLER is invoked with the URL.
+
+A HANDLER must be a function with the same arguments as
+`browse-url'.
+
+If no REGEXP-OR-PREDICATE matches, the same procedure is
+performed with the value of `browse-url-default-handlers'. If
+there is also no match, the URL is opened using the value of
+`browse-url-browser-function'."
+ :type '(alist :key-type (choice
+ (regexp :tag "Regexp")
+ (function :tag "Predicate"))
+ :value-type (function :tag "Handler"))
+ :version "28.1")
+
+;;;###autoload
+(defun browse-url-select-handler (url &optional kind)
+ "Return a handler of suitable for browsing URL.
+This searches `browse-url-handlers', and
+`browse-url-default-handlers' for a matching handler. Return nil
+if no handler is found.
+
+If KIND is given, the search is restricted to handlers whose
+function symbol has the symbol-property `browse-url-browser-kind'
+set to KIND.
+
+Currently, it also consults `browse-url-browser-function' first
+if it is set to an alist, although this usage is deprecated since
+Emacs 28.1 and will be removed in a future release."
+ (catch 'custom-url-handler
+ (dolist (rxpred-handler
+ (append
+ ;; The alist choice of browse-url-browser-function
+ ;; is deprecated since 28.1, so the (unless ...)
+ ;; can be removed at some point in time.
+ (when (and (consp browse-url-browser-function)
+ (not (functionp browse-url-browser-function)))
+ (lwarn 'browse-url :warning
+ "Having `browse-url-browser-function' set to an
+alist is deprecated. Use `browse-url-handlers' instead.")
+ browse-url-browser-function)
+ browse-url-handlers
+ browse-url-default-handlers))
+ (let ((rx-or-pred (car rxpred-handler))
+ (handler (cdr rxpred-handler)))
+ (when (and (or (null kind)
+ (eq kind (browse-url--browser-kind
+ handler url)))
+ (if (functionp rx-or-pred)
+ (funcall rx-or-pred url)
+ (string-match-p rx-or-pred url)))
+ (throw 'custom-url-handler handler))))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; URL encoding
@@ -768,16 +893,18 @@ narrowed."
"Ask a WWW browser to load URL.
Prompt for a URL, defaulting to the URL at or before point.
Invokes a suitable browser function which does the actual job.
-The variable `browse-url-browser-function' says which browser function to
-use. If the URL is a mailto: URL, consult `browse-url-mailto-function'
-first, if that exists.
-
-The additional ARGS are passed to the browser function. See the doc
-strings of the actual functions, starting with `browse-url-browser-function',
-for information about the significance of ARGS (most of the functions
-ignore it).
-If ARGS are omitted, the default is to pass `browse-url-new-window-flag'
-as ARGS."
+
+The variables `browse-url-browser-function',
+`browse-url-handlers', and `browse-url-default-handlers'
+determine which browser function to use.
+
+The additional ARGS are passed to the browser function. See the
+doc strings of the actual functions, starting with
+`browse-url-browser-function', for information about the
+significance of ARGS (most of the functions ignore it).
+
+If ARGS are omitted, the default is to pass
+`browse-url-new-window-flag' as ARGS."
(interactive (browse-url-interactive-arg "URL: "))
(unless (called-interactively-p 'interactive)
(setq args (or args (list browse-url-new-window-flag))))
@@ -786,12 +913,9 @@ as ARGS."
(not (string-match "\\`[a-z]+:" url)))
(setq url (expand-file-name url)))
(let ((process-environment (copy-sequence process-environment))
- (function (or (and (string-match "\\`mailto:"; url)
- browse-url-mailto-function)
- (and (string-match "\\`man:" url)
- browse-url-man-function)
- browse-url-browser-function))
- ;; Ensure that `default-directory' exists and is readable (b#6077).
+ (function (or (browse-url-select-handler url)
+ browse-url-browser-function))
+ ;; Ensure that `default-directory' exists and is readable (bug#6077).
(default-directory (or (unhandled-file-name-directory default-directory)
(expand-file-name "~/"))))
;; When connected to various displays, be careful to use the display of
@@ -799,20 +923,9 @@ as ARGS."
;; which may not even exist any more.
(if (stringp (frame-parameter nil 'display))
(setenv "DISPLAY" (frame-parameter nil 'display)))
- (if (and (consp function)
- (not (functionp function)))
- ;; The `function' can be an alist; look down it for first match
- ;; and apply the function (which might be a lambda).
- (catch 'done
- (dolist (bf function)
- (when (string-match (car bf) url)
- (apply (cdr bf) url args)
- (throw 'done t)))
- (error "No browse-url-browser-function matching URL %s"
- url))
- ;; Unbound symbols go down this leg, since void-function from
- ;; apply is clearer than wrong-type-argument from dolist.
- (apply function url args))))
+ (if (functionp function)
+ (apply function url args)
+ (error "No suitable browser for URL %s" url))))
;;;###autoload
(defun browse-url-at-point (&optional arg)
@@ -829,6 +942,34 @@ Optional prefix argument ARG non-nil inverts the value of
the option
(error "No URL found"))))
;;;###autoload
+(defun browse-url-with-browser-kind (kind url &optional arg)
+ "Browse URL with a browser of the given browser KIND.
+KIND is either `internal' or `external'.
+
+When called interactively, the default browser kind is the
+opposite of the browser kind of `browse-url-browser-function'."
+ (interactive
+ (let* ((url-arg (browse-url-interactive-arg "URL: "))
+ ;; Default to the inverse kind of the default browser.
+ (default (if (eq (browse-url--browser-kind
+ browse-url-browser-function (car url-arg))
+ 'internal)
+ 'external
+ 'internal))
+ (k (intern (completing-read
+ (format "Browser kind (default %s): " default)
+ '(internal external)
+ nil t nil nil
+ default))))
+ (cons k url-arg)))
+ (let ((function (browse-url-select-handler url kind)))
+ (unless function
+ (setq function (if (eq kind 'external)
+ #'browse-url-default-browser
+ #'eww)))
+ (funcall function url arg)))
+
+;;;###autoload
(defun browse-url-at-mouse (event)
"Ask a WWW browser to load a URL clicked with the mouse.
The URL is the one around or before the position of the mouse click
@@ -875,12 +1016,18 @@ The optional NEW-WINDOW argument is not used."
(url-unhex-string url)
url)))))
+(function-put 'browse-url-default-windows-browser 'browse-url-browser-kind
+ 'external)
+
(defun browse-url-default-macosx-browser (url &optional _new-window)
"Invoke the macOS system's default Web browser.
The optional NEW-WINDOW argument is not used."
(interactive (browse-url-interactive-arg "URL: "))
(start-process (concat "open " url) nil "open" url))
+(function-put 'browse-url-default-macosx-browser 'browse-url-browser-kind
+ 'external)
+
;; --- Netscape ---
(defun browse-url-process-environment ()
@@ -929,7 +1076,7 @@ instead of `browse-url-new-window-flag'."
((executable-find browse-url-kde-program) 'browse-url-kde)
;;; ((executable-find browse-url-netscape-program) 'browse-url-netscape)
;;; ((executable-find browse-url-mosaic-program) 'browse-url-mosaic)
- ((executable-find browse-url-conkeror-program) 'browse-url-conkeror)
+;;; ((executable-find browse-url-conkeror-program) 'browse-url-conkeror)
((executable-find browse-url-chrome-program) 'browse-url-chrome)
((executable-find browse-url-xterm-program) 'browse-url-text-xterm)
((locate-library "w3") 'browse-url-w3)
@@ -937,6 +1084,10 @@ instead of `browse-url-new-window-flag'."
(lambda (&rest _ignore) (error "No usable browser found"))))
url args))
+(function-put 'browse-url-default-browser 'browse-url-browser-kind
+ ;; Well, most probably external if we ignore w3.
+ 'external)
+
(defun browse-url-can-use-xdg-open ()
"Return non-nil if the \"xdg-open\" program can be used.
xdg-open is a desktop utility that calls your preferred web browser."
@@ -956,6 +1107,8 @@ The optional argument IGNORED is not used."
(interactive (browse-url-interactive-arg "URL: "))
(call-process "xdg-open" nil 0 nil url))
+(function-put 'browse-url-xdg-open 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-netscape (url &optional new-window)
"Ask the Netscape WWW browser to load URL.
@@ -999,6 +1152,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-netscape-sentinel process ,url)))))
+(function-put 'browse-url-netscape 'browse-url-browser-kind 'external)
+
(defun browse-url-netscape-sentinel (process url)
"Handle a change to the process communicating with Netscape."
(declare (obsolete nil "25.1"))
@@ -1069,6 +1224,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-mozilla-sentinel process ,url)))))
+(function-put 'browse-url-mozilla 'browse-url-browser-kind 'external)
+
(defun browse-url-mozilla-sentinel (process url)
"Handle a change to the process communicating with Mozilla."
(or (eq (process-exit-status process) 0)
@@ -1109,6 +1266,8 @@ instead of `browse-url-new-window-flag'."
'("-new-window")))
(list url)))))
+(function-put 'browse-url-firefox 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-chromium (url &optional _new-window)
"Ask the Chromium WWW browser to load URL.
@@ -1126,6 +1285,8 @@ The optional argument NEW-WINDOW is not used."
browse-url-chromium-arguments
(list url)))))
+(function-put 'browse-url-chromium 'browse-url-browser-kind 'external)
+
(defun browse-url-chrome (url &optional _new-window)
"Ask the Google Chrome WWW browser to load URL.
Default to the URL around or before point. The strings in
@@ -1142,6 +1303,8 @@ The optional argument NEW-WINDOW is not used."
browse-url-chrome-arguments
(list url)))))
+(function-put 'browse-url-chrome 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-galeon (url &optional new-window)
"Ask the Galeon WWW browser to load URL.
@@ -1179,6 +1342,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-galeon-sentinel process ,url)))))
+(function-put 'browse-url-galeon 'browse-url-browser-kind 'external)
+
(defun browse-url-galeon-sentinel (process url)
"Handle a change to the process communicating with Galeon."
(declare (obsolete nil "25.1"))
@@ -1225,6 +1390,8 @@ used instead of `browse-url-new-window-flag'."
`(lambda (process change)
(browse-url-epiphany-sentinel process ,url)))))
+(function-put 'browse-url-epiphany 'browse-url-browser-kind 'external)
+
(defun browse-url-epiphany-sentinel (process url)
"Handle a change to the process communicating with Epiphany."
(or (eq (process-exit-status process) 0)
@@ -1249,6 +1416,8 @@ currently selected window instead."
file-name-handler-alist)))
(if same-window (find-file url) (find-file-other-window url))))
+(function-put 'browse-url-emacs 'browse-url-browser-kind 'internal)
+
;;;###autoload
(defun browse-url-gnome-moz (url &optional new-window)
"Ask Mozilla/Netscape to load URL via the GNOME program `gnome-moz-remote'.
@@ -1273,6 +1442,8 @@ used instead of `browse-url-new-window-flag'."
'("--newwin"))
(list "--raise" url))))
+(function-put 'browse-url-gnome-moz 'browse-url-browser-kind 'external)
+
;; --- Mosaic ---
;;;###autoload
@@ -1324,6 +1495,8 @@ used instead of `browse-url-new-window-flag'."
(append browse-url-mosaic-arguments (list url)))
(message "Starting %s...done" browse-url-mosaic-program))))
+(function-put 'browse-url-mosaic 'browse-url-browser-kind 'external)
+
;; --- Mosaic using CCI ---
;;;###autoload
@@ -1356,6 +1529,8 @@ used instead of `browse-url-new-window-flag'."
(process-send-string "browse-url" "disconnect\r\n")
(delete-process "browse-url"))
+(function-put 'browse-url-cci 'browse-url-browser-kind 'external)
+
;; --- Conkeror ---
;;;###autoload
(defun browse-url-conkeror (url &optional new-window)
@@ -1375,6 +1550,7 @@ new window, load it in a new buffer in an existing window
instead.
When called non-interactively, use optional second argument
NEW-WINDOW instead of `browse-url-new-window-flag'."
+ (declare (obsolete nil "28.1"))
(interactive (browse-url-interactive-arg "URL: "))
(setq url (browse-url-encode-url url))
(let* ((process-environment (browse-url-process-environment)))
@@ -1392,6 +1568,9 @@ NEW-WINDOW instead of `browse-url-new-window-flag'."
"window")
"buffer")
url))))))
+
+(function-put 'browse-url-conkeror 'browse-url-browser-kind 'external)
+
;; --- W3 ---
;; External.
@@ -1415,6 +1594,8 @@ used instead of `browse-url-new-window-flag'."
(w3-fetch-other-window url)
(w3-fetch url)))
+(function-put 'browse-url-w3 'browse-url-browser-kind 'internal)
+
;;;###autoload
(defun browse-url-w3-gnudoit (url &optional _new-window)
;; new-window ignored
@@ -1429,6 +1610,8 @@ The `browse-url-gnudoit-program' program is used with
options given by
(list (concat "(w3-fetch \"" url "\")")
"(raise-frame)"))))
+(function-put 'browse-url-w3-gnudoit 'browse-url-browser-kind 'internal)
+
;; --- Lynx in an xterm ---
;;;###autoload
@@ -1446,6 +1629,8 @@ The optional argument NEW-WINDOW is not used."
,@browse-url-xterm-args "-e" ,browse-url-text-browser
,url)))
+(function-put 'browse-url-text-xterm 'browse-url-browser-kind 'external)
+
;; --- Lynx in an Emacs "term" window ---
(declare-function term-char-mode "term" ())
@@ -1520,6 +1705,8 @@ used instead of `browse-url-new-window-flag'."
url
"\r")))))
+(function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal)
+
;; --- mailto ---
(autoload 'rfc2368-parse-mailto-url "rfc2368")
@@ -1567,6 +1754,8 @@ used instead of `browse-url-new-window-flag'."
(unless (bolp)
(insert "\n"))))))))
+(function-put 'browse-url-mail 'browse-url-browser-kind 'internal)
+
;; --- man ---
(defvar manual-program)
@@ -1578,7 +1767,9 @@ used instead of `browse-url-new-window-flag'."
(setq url (replace-regexp-in-string "\\`man:" "" url))
(cond
((executable-find manual-program) (man url))
- (t (woman (replace-regexp-in-string "([[:alnum:]]+)" "" url)))))
+ (t (woman (replace-regexp-in-string "([[:alnum:]]+)" "" url)))))
+
+(function-put 'browse-url-man 'browse-url-browser-kind 'internal)
;; --- Random browser ---
@@ -1597,6 +1788,8 @@ don't offer a form of remote control."
0 nil
(append browse-url-generic-args (list url))))
+(function-put 'browse-url-generic 'browse-url-browser-kind 'external)
+
;;;###autoload
(defun browse-url-kde (url &optional _new-window)
"Ask the KDE WWW browser to load URL.
@@ -1607,6 +1800,8 @@ The optional argument NEW-WINDOW is not used."
(apply #'start-process (concat "KDE " url) nil browse-url-kde-program
(append browse-url-kde-args (list url))))
+(function-put 'browse-url-kde 'browse-url-browser-kind 'external)
+
(defun browse-url-elinks-new-window (url)
"Ask the Elinks WWW browser to load URL in a new window."
(let ((process-environment (browse-url-process-environment)))
@@ -1616,6 +1811,9 @@ The optional argument NEW-WINDOW is not used."
browse-url-elinks-wrapper
(list "elinks" url)))))
+(function-put 'browse-url-elinks-new-window 'browse-url-browser-kind
+ 'external)
+
;;;###autoload
(defun browse-url-elinks (url &optional new-window)
"Ask the Elinks WWW browser to load URL.
@@ -1637,6 +1835,8 @@ from `browse-url-elinks-wrapper'."
`(lambda (process change)
(browse-url-elinks-sentinel process ,url))))))
+(function-put 'browse-url-elinks 'browse-url-browser-kind 'external)
+
(defun browse-url-elinks-sentinel (process url)
"Determines if Elinks is running or a new one has to be started."
;; Try to determine if an instance is running or if we have to
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index c83884f..2a70560 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -307,9 +307,11 @@ the default EWW buffer."
(insert (format "Loading %s..." url))
(goto-char (point-min)))
(let ((url-mime-accept-string eww-accept-content-types))
- (url-retrieve url 'eww-render
+ (url-retrieve url #'eww-render
(list url nil (current-buffer)))))
+(function-put 'eww 'browse-url-browser-kind 'internal)
+
(defun eww--dwim-expand-url (url)
(setq url (string-trim url))
(cond ((string-match-p "\\`file:/" url))
@@ -373,8 +375,8 @@ engine used."
(let ((region-string (buffer-substring (region-beginning) (region-end))))
(if (not (string-match-p "\\`[ \n\t\r\v\f]*\\'" region-string))
(eww region-string)
- (call-interactively 'eww)))
- (call-interactively 'eww)))
+ (call-interactively #'eww)))
+ (call-interactively #'eww)))
(defun eww-open-in-new-buffer ()
"Fetch link at point in a new EWW buffer."
@@ -518,6 +520,10 @@ Currently this means either text/html or
application/xhtml+xml."
(plist-put eww-data :dom document)
(let ((inhibit-read-only t)
(inhibit-modification-hooks t)
+ ;; Possibly set by the caller, e.g., `eww-render' which
+ ;; preserves the old URL #target before chasing redirects.
+ (shr-target-id (or shr-target-id
+ (url-target (url-generic-parse-url url))))
(shr-external-rendering-functions
(append
shr-external-rendering-functions
@@ -1007,7 +1013,7 @@ just re-display the HTML already fetched."
(eww-display-html 'utf-8 url (plist-get eww-data :dom)
(point) (current-buffer)))
(let ((url-mime-accept-string eww-accept-content-types))
- (url-retrieve url 'eww-render
+ (url-retrieve url #'eww-render
(list url (point) (current-buffer) encode))))))
;; Form support.
@@ -1570,8 +1576,10 @@ If EXTERNAL is double prefix, browse in new buffer."
(cond
((not url)
(message "No link under point"))
- ((string-match "^mailto:"; url)
- (browse-url-mail url))
+ ((string-match-p "\\`mailto:"; url)
+ ;; This respects the user options `browse-url-handlers'
+ ;; and `browse-url-mailto-function'.
+ (browse-url url))
((and (consp external) (<= (car external) 4))
(funcall browse-url-secondary-browser-function url)
(shr--blink-link))
@@ -1609,7 +1617,7 @@ Use link at point if there is one, else the current
page's URL."
(eww-current-url))))
(if (not url)
(message "No URL under point")
- (url-retrieve url 'eww-download-callback (list url)))))
+ (url-retrieve url #'eww-download-callback (list url)))))
(defun eww-download-callback (status url)
(unless (plist-get status :error)
@@ -1733,7 +1741,7 @@ If CHARSET is nil then use UTF-8."
(defun eww-write-bookmarks ()
(with-temp-file (expand-file-name "eww-bookmarks" eww-bookmarks-directory)
- (insert ";; Auto-generated file; don't edit\n")
+ (insert ";; Auto-generated file; don't edit -*- mode: lisp-data -*-\n")
(pp eww-bookmarks (current-buffer))))
(defun eww-read-bookmarks ()
@@ -2122,12 +2130,12 @@ entries (if any) will be removed from the list.
Only the properties listed in `eww-desktop-data-save' are included.
Generally, the list should not include the (usually overly large)
:dom, :source and :text properties."
- (let ((history (mapcar 'eww-desktop-data-1
- (cons eww-data eww-history))))
- (list :history (if eww-desktop-remove-duplicates
- (cl-remove-duplicates
- history :test 'eww-desktop-history-duplicate)
- history))))
+ (let ((history (mapcar #'eww-desktop-data-1
+ (cons eww-data eww-history))))
+ (list :history (if eww-desktop-remove-duplicates
+ (cl-remove-duplicates
+ history :test #'eww-desktop-history-duplicate)
+ history))))
(defun eww-restore-desktop (file-name buffer-name misc-data)
"Restore an eww buffer from its desktop file record.
diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el
index 92efb6b..974ee0d 100644
--- a/lisp/net/hmac-md5.el
+++ b/lisp/net/hmac-md5.el
@@ -1,4 +1,4 @@
-;;; hmac-md5.el --- Compute HMAC-MD5.
+;;; hmac-md5.el --- Compute HMAC-MD5. -*- lexical-binding:t -*-
;; Copyright (C) 1999, 2001, 2007-2020 Free Software Foundation, Inc.
@@ -22,42 +22,8 @@
;;; Commentary:
-;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1".
-;;
-;; (encode-hex-string (hmac-md5 "Hi There" (make-string 16 ?\x0b)))
-;; => "9294727a3638bb1c13f48ef8158bfc9d"
-;;
-;; (encode-hex-string (hmac-md5 "what do ya want for nothing?" "Jefe"))
-;; => "750c783e6ab0b503eaa86e310a5db738"
-;;
-;; (encode-hex-string (hmac-md5 (make-string 50 ?\xdd) (make-string 16 ?\xaa)))
-;; => "56be34521d144c88dbb8c733f0e8b3f6"
-;;
-;; (encode-hex-string
-;; (hmac-md5
-;; (make-string 50 ?\xcd)
-;; (decode-hex-string "0102030405060708090a0b0c0d0e0f10111213141516171819")))
-;; => "697eaf0aca3a3aea3a75164746ffaa79"
-;;
-;; (encode-hex-string
-;; (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c)))
-;; => "56461ef2342edc00f9bab995690efd4c"
-;;
-;; (encode-hex-string
-;; (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c)))
-;; => "56461ef2342edc00f9bab995"
-;;
-;; (encode-hex-string
-;; (hmac-md5
-;; "Test Using Larger Than Block-Size Key - Hash Key First"
-;; (make-string 80 ?\xaa)))
-;; => "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"
-;;
-;; (encode-hex-string
-;; (hmac-md5
-;; "Test Using Larger Than Block-Size Key and Larger Than One Block-Size
Data"
-;; (make-string 80 ?\xaa)))
-;; => "6f630fad67cda0ee1fb1f562db3aa53e"
+;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1",
+;; moved to lisp/test/net/hmac-md5-tests.el
;;; Code:
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index 2d36c5e..cc22427 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -964,6 +964,7 @@ protocol."
(defun nsm-write-settings ()
(with-temp-file nsm-settings-file
+ (insert ";;;; -*- mode: lisp-data -*-\n")
(insert "(\n")
(dolist (setting nsm-permanent-host-settings)
(insert " ")
diff --git a/lisp/net/puny.el b/lisp/net/puny.el
index 6987d25..cc40607 100644
--- a/lisp/net/puny.el
+++ b/lisp/net/puny.el
@@ -1,4 +1,4 @@
-;;; puny.el --- translate non-ASCII domain names to ASCII
+;;; puny.el --- translate non-ASCII domain names to ASCII -*-
lexical-binding:t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
diff --git a/lisp/net/shr.el b/lisp/net/shr.el
index 1f80ab7..03260c9 100644
--- a/lisp/net/shr.el
+++ b/lisp/net/shr.el
@@ -135,7 +135,7 @@ same domain as the main data."
This is used for cid: URLs, and the function is called with the
cid: URL as the argument.")
-(defvar shr-put-image-function 'shr-put-image
+(defvar shr-put-image-function #'shr-put-image
"Function called to put image and alt string.")
(defface shr-strike-through '((t :strike-through t))
@@ -365,25 +365,20 @@ If the URL is already at the front of the kill ring act
like
(shr-copy-url url)))
(defun shr--current-link-region ()
- (let ((current (get-text-property (point) 'shr-url))
- start)
- (save-excursion
- ;; Go to the beginning.
- (while (and (not (bobp))
- (equal (get-text-property (point) 'shr-url) current))
- (forward-char -1))
- (unless (equal (get-text-property (point) 'shr-url) current)
- (forward-char 1))
- (setq start (point))
- ;; Go to the end.
- (while (and (not (eobp))
- (equal (get-text-property (point) 'shr-url) current))
- (forward-char 1))
- (list start (point)))))
+ "Return the start and end positions of the URL at point, if any.
+Value is a pair of positions (START . END) if there is a non-nil
+`shr-url' text property at point; otherwise nil."
+ (when (get-text-property (point) 'shr-url)
+ (let* ((end (or (next-single-property-change (point) 'shr-url)
+ (point-max)))
+ (beg (or (previous-single-property-change end 'shr-url)
+ (point-min))))
+ (cons beg end))))
(defun shr--blink-link ()
- (let* ((region (shr--current-link-region))
- (overlay (make-overlay (car region) (cadr region))))
+ "Briefly fontify URL at point with the face `shr-selected-link'."
+ (when-let* ((region (shr--current-link-region))
+ (overlay (make-overlay (car region) (cdr region))))
(overlay-put overlay 'face 'shr-selected-link)
(run-at-time 1 nil (lambda ()
(delete-overlay overlay)))))
@@ -437,7 +432,7 @@ the URL of the image to the kill buffer instead."
(if (not url)
(message "No image under point")
(message "Inserting %s..." url)
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) (1- (point)) (point-marker))
t))))
@@ -463,7 +458,7 @@ size, and full-buffer size."
(when (> (- (point) start) 2)
(delete-region start (1- (point)))))
(message "Inserting %s..." url)
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) (1- (point)) (point-marker)
(list (cons 'size
(cond ((or (eq size 'default)
@@ -493,7 +488,7 @@ size, and full-buffer size."
((fboundp function)
(apply function dom args))
(t
- (apply 'shr-generic dom args)))))
+ (apply #'shr-generic dom args)))))
(defun shr-descend (dom)
(let ((function
@@ -730,9 +725,10 @@ size, and full-buffer size."
(let ((gap-start (point))
(face (get-text-property (point) 'face)))
;; Extend the background to the end of the line.
- (if face
- (insert (propertize "\n" 'face (shr-face-background face)))
- (insert "\n"))
+ (insert ?\n)
+ (when face
+ (put-text-property (1- (point)) (point)
+ 'face (shr-face-background face)))
(shr-indent)
(when (and (> (1- gap-start) (point-min))
(get-text-property (point) 'shr-url)
@@ -935,12 +931,11 @@ size, and full-buffer size."
(defun shr-indent ()
(when (> shr-indentation 0)
- (insert
- (if (not shr-use-fonts)
- (make-string shr-indentation ?\s)
- (propertize " "
- 'display
- `(space :width (,shr-indentation)))))))
+ (if (not shr-use-fonts)
+ (insert-char ?\s shr-indentation)
+ (insert ?\s)
+ (put-text-property (1- (point)) (point)
+ 'display `(space :width (,shr-indentation))))))
(defun shr-fontize-dom (dom &rest types)
(let ((start (point)))
@@ -987,16 +982,11 @@ the mouse click event."
(cond
((not url)
(message "No link under point"))
- ((string-match "^mailto:"; url)
- (browse-url-mail url))
+ (external
+ (funcall browse-url-secondary-browser-function url)
+ (shr--blink-link))
(t
- (if external
- (progn
- (funcall browse-url-secondary-browser-function url)
- (shr--blink-link))
- (browse-url url (if new-window
- (not browse-url-new-window-flag)
- browse-url-new-window-flag)))))))
+ (browse-url url (xor new-window browse-url-new-window-flag))))))
(defun shr-save-contents (directory)
"Save the contents from URL in a file."
@@ -1005,7 +995,7 @@ the mouse click event."
(if (not url)
(message "No link under point")
(url-retrieve (shr-encode-url url)
- 'shr-store-contents (list url directory)))))
+ #'shr-store-contents (list url directory)))))
(defun shr-store-contents (status url directory)
(unless (plist-get status :error)
@@ -1156,7 +1146,6 @@ width/height instead."
;; url-cache-extract autoloads url-cache.
(declare-function url-cache-create-filename "url-cache" (url))
-(autoload 'browse-url-mail "browse-url")
(defun shr-get-image-data (url)
"Get image data for URL.
@@ -1230,7 +1219,7 @@ START, and END. Note that START and END should be
markers."
(funcall shr-put-image-function
image (buffer-substring start end))
(delete-region (point) end))))
- (url-retrieve url 'shr-image-fetched
+ (url-retrieve url #'shr-image-fetched
(list (current-buffer) start end)
t t)))))
@@ -1679,7 +1668,7 @@ The preference is a float determined from
`shr-prefer-media-type'."
(or alt "")))
(insert " ")
(url-queue-retrieve
- (shr-encode-url url) 'shr-image-fetched
+ (shr-encode-url url) #'shr-image-fetched
(list (current-buffer) start (set-marker (make-marker) (point))
(list :width width :height height))
t
@@ -2006,12 +1995,11 @@ BASE is the URL of the HTML being rendered."
(cond
((null tbodies)
dom)
- ((= (length tbodies) 1)
+ ((null (cdr tbodies))
(car tbodies))
(t
;; Table with multiple tbodies. Convert into a single tbody.
- `(tbody nil ,@(cl-reduce 'append
- (mapcar 'dom-non-text-children tbodies)))))))
+ `(tbody nil ,@(mapcan #'dom-non-text-children tbodies))))))
(defun shr--fix-tbody (tbody)
(nconc (list 'tbody (dom-attributes tbody))
@@ -2311,8 +2299,8 @@ flags that control whether to collect or render objects."
(dolist (column row)
(aset natural-widths i (max (aref natural-widths i) column))
(setq i (1+ i)))))
- (let ((extra (- (apply '+ (append suggested-widths nil))
- (apply '+ (append widths nil))
+ (let ((extra (- (apply #'+ (append suggested-widths nil))
+ (apply #'+ (append widths nil))
(* shr-table-separator-pixel-width (1+ (length widths)))))
(expanded-columns 0))
;; We have extra, unused space, so divide this space amongst the
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index aae25d1..b4a080e 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -896,14 +896,13 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
;; it. Call it in a subshell, in order to preserve working
;; directory.
(condition-case nil
- (progn
- (setq ret
- (if (tramp-adb-send-command-and-check
- v
- (format "(cd %s; %s)"
- (tramp-shell-quote-argument localname) command))
- ;; Set return status accordingly.
- 0 1))
+ (unwind-protect
+ (setq ret (tramp-adb-send-command-and-check
+ v (format
+ "(cd %s; %s)"
+ (tramp-shell-quote-argument localname) command)
+ t))
+ (unless (natnump ret) (setq ret 1))
;; We should add the output anyway.
(when outbuf
(with-current-buffer outbuf
@@ -919,6 +918,12 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are
completely ignored."
(kill-buffer (tramp-get-connection-buffer v))
(setq ret 1)))
+ ;; Handle signals. `process-file-return-signal-string' exists
+ ;; since Emacs 28.1.
+ (when (and (bound-and-true-p process-file-return-signal-string)
+ (natnump ret) (> ret 128))
+ (setq ret (nth (- ret 128) (tramp-get-signal-strings))))
+
;; Provide error file.
(when tmpstderr (rename-file tmpstderr (cadr destination) t))
@@ -1186,11 +1191,14 @@ This happens for Android >= 4.0."
(while (re-search-forward "\r+$" nil t)
(replace-match "" nil nil))))))
-(defun tramp-adb-send-command-and-check (vec command)
+(defun tramp-adb-send-command-and-check (vec command &optional exit-status)
"Run COMMAND and check its exit status.
Sends `echo $?' along with the COMMAND for checking the exit
status. If COMMAND is nil, just sends `echo $?'. Returns nil if
-the exit status is not equal 0, and t otherwise."
+the exit status is not equal 0, and t otherwise.
+
+Optional argument EXIT-STATUS, if non-nil, triggers the return of
+the exit status."
(tramp-adb-send-command
vec (if command
(format "%s; echo tramp_exit_status $?" command)
@@ -1201,7 +1209,9 @@ the exit status is not equal 0, and t otherwise."
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
(prog1
- (zerop (read (current-buffer)))
+ (if exit-status
+ (read (current-buffer))
+ (zerop (read (current-buffer))))
(let ((inhibit-read-only t))
(delete-region (match-beginning 0) (point-max))))))
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 95cbfb8..24ee6fa 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -109,7 +109,7 @@
(eval-when-compile (require 'cl-lib))
;; Sometimes, compilation fails with "Variable binding depth exceeds
-;; max-specpdl-size".
+;; max-specpdl-size". Shall be fixed in Emacs 27.
(eval-and-compile
(let ((max-specpdl-size (* 2 max-specpdl-size))) (require 'tramp-gvfs)))
@@ -318,7 +318,10 @@ arguments to pass to the OPERATION."
(let* ((filename (apply #'tramp-archive-file-name-for-operation
operation args))
- (archive (tramp-archive-file-name-archive filename)))
+ (archive (tramp-archive-file-name-archive filename))
+ ;; Sometimes, it fails with "Variable binding depth exceeds
+ ;; max-specpdl-size". Shall be fixed in Emacs 27.
+ (max-specpdl-size (* 2 max-specpdl-size)))
;; `filename' could be a quoted file name. Or the file
;; archive could be a directory, see Bug#30293.
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 09e30f0..02400f9 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -139,23 +139,29 @@ Return DEFAULT if not set."
(tramp-run-real-handler #'directory-file-name (list file))
(tramp-file-name-hop key) nil)
(let* ((hash (tramp-get-hash-table key))
- (value (when (hash-table-p hash) (gethash property hash))))
- (if ;; We take the value only if there is any, and
- ;; `remote-file-name-inhibit-cache' indicates that it is still
- ;; valid. Otherwise, DEFAULT is set.
- (and (consp value)
+ (cached (and (hash-table-p hash) (gethash property hash)))
+ (cached-at (and (consp cached) (format-time-string "%T" (car cached))))
+ (value default)
+ use-cache)
+
+ (when ;; We take the value only if there is any, and
+ ;; `remote-file-name-inhibit-cache' indicates that it is
+ ;; still valid. Otherwise, DEFAULT is set.
+ (and (consp cached)
(or (null remote-file-name-inhibit-cache)
(and (integerp remote-file-name-inhibit-cache)
(time-less-p
nil
- (time-add (car value) remote-file-name-inhibit-cache)))
+ (time-add (car cached) remote-file-name-inhibit-cache)))
(and (consp remote-file-name-inhibit-cache)
(time-less-p
- remote-file-name-inhibit-cache (car value)))))
- (setq value (cdr value))
- (setq value default))
+ remote-file-name-inhibit-cache (car cached)))))
+ (setq value (cdr cached)
+ use-cache t))
- (tramp-message key 8 "%s %s %s" file property value)
+ (tramp-message key 8 "%s %s %s; inhibit: %s; cache used: %s; cached at: %s"
+ file property value
+ remote-file-name-inhibit-cache use-cache cached-at)
(when (>= tramp-verbose 10)
(let* ((var (intern (concat "tramp-cache-get-count-" property)))
(val (or (numberp (bound-and-true-p var))
@@ -310,15 +316,19 @@ the connection, return DEFAULT."
(setf (tramp-file-name-localname key) nil
(tramp-file-name-hop key) nil))
(let* ((hash (tramp-get-hash-table key))
- (value
- ;; If the key is an auxiliary process object, check whether
- ;; the process is still alive.
- (if (and (processp key) (not (process-live-p key)))
- default
- (if (hash-table-p hash)
- (gethash property hash default)
- default))))
- (tramp-message key 7 "%s %s" property value)
+ (cached (if (hash-table-p hash)
+ (gethash property hash tramp-cache-undefined)
+ tramp-cache-undefined))
+ (value default)
+ use-cache)
+
+ (when (and (not (eq cached tramp-cache-undefined))
+ ;; If the key is an auxiliary process object, check
+ ;; whether the process is still alive.
+ (not (and (processp key) (not (process-live-p key)))))
+ (setq value cached
+ use-cache t))
+ (tramp-message key 7 "%s %s; cache used: %s" property value use-cache)
value))
;;;###tramp-autoload
@@ -472,15 +482,10 @@ used to cache connection properties of the local machine."
;; Dump it.
(with-temp-file tramp-persistency-file-name
(insert
- ";; -*- emacs-lisp -*-"
- ;; `time-stamp-string' might not exist in all Emacs flavors.
- (condition-case nil
- (progn
- (format
- " <%s %s>\n"
- (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
- tramp-persistency-file-name))
- (error "\n"))
+ ;; Starting with Emacs 28, we could use `lisp-data'.
+ (format ";; -*- emacs-lisp -*- <%s %s>\n"
+ (time-stamp-string "%02y/%02m/%02d %02H:%02M:%02S")
+ tramp-persistency-file-name)
";; Tramp connection history. Don't change this file.\n"
";; Run `M-x tramp-cleanup-all-connections' instead.\n\n"
(with-output-to-string
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 7d353e2..1742da8 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -74,11 +74,13 @@ SYNTAX can be one of the symbols `default' (default),
Each function is called with the current vector as argument.")
;;;###tramp-autoload
-(defun tramp-cleanup-connection (vec &optional keep-debug keep-password)
+(defun tramp-cleanup-connection
+ (vec &optional keep-debug keep-password keep-processes)
"Flush all connection related objects.
This includes password cache, file cache, connection cache,
-buffers. KEEP-DEBUG non-nil preserves the debug buffer.
-KEEP-PASSWORD non-nil preserves the password cache.
+buffers, processes. KEEP-DEBUG non-nil preserves the debug
+buffer. KEEP-PASSWORD non-nil preserves the password cache.
+KEEP-PROCESSES non-nil preserves the asynchronous processes.
When called interactively, a Tramp connection has to be selected."
(interactive
;; When interactive, select the Tramp remote identification.
@@ -116,7 +118,9 @@ When called interactively, a Tramp connection has to be
selected."
;; Delete processes.
(dolist (key (hash-table-keys tramp-cache-data))
(when (and (processp key)
- (tramp-file-name-equal-p (process-get key 'vector) vec))
+ (tramp-file-name-equal-p (process-get key 'vector) vec)
+ (or (not keep-processes)
+ (eq key (tramp-get-process vec))))
(tramp-flush-connection-properties key)
(delete-process key)))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index f19e510..704d65c 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -125,7 +125,10 @@
(autoload 'zeroconf-init "zeroconf")
(tramp-compat-funcall 'dbus-get-unique-name :system)
(tramp-compat-funcall 'dbus-get-unique-name :session)
- (or (tramp-process-running-p "gvfs-fuse-daemon")
+ (or ;; Until Emacs 25, `process-attributes' could crash Emacs
+ ;; for some processes. Better we don't check.
+ (<= emacs-major-version 25)
+ (tramp-process-running-p "gvfs-fuse-daemon")
(tramp-process-running-p "gvfsd-fuse"))))
"Non-nil when GVFS is available.")
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 445098a..08bba33 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -477,7 +477,18 @@ file names."
(with-tramp-connection-property
(tramp-get-connection-process vec) "rclone-pid"
(catch 'pid
- (dolist (pid (list-system-processes)) ;; "pidof rclone" ?
+ (dolist
+ (pid
+ ;; Until Emacs 25, `process-attributes' could
+ ;; crash Emacs for some processes. So we use
+ ;; "pidof", which might not work everywhere.
+ (if (<= emacs-major-version 25)
+ (let ((default-directory temporary-file-directory))
+ (mapcar
+ #'string-to-number
+ (split-string
+ (shell-command-to-string "pidof rclone"))))
+ (list-system-processes)))
(and (string-match-p
(regexp-quote
(format "rclone mount %s:" (tramp-file-name-host vec)))
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index a39d503..523663c 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2912,6 +2912,11 @@ STDERR can also be a file name."
(setq uenv (cons elt uenv)))))))
(command
(when (stringp program)
+ (setenv-internal
+ env "INSIDE_EMACS"
+ (concat (or (getenv "INSIDE_EMACS") emacs-version)
+ ",tramp:" tramp-version)
+ 'keep)
(format "cd %s && %s exec %s %s env %s %s"
(tramp-shell-quote-argument localname)
(if uenv
@@ -3061,6 +3066,11 @@ STDERR can also be a file name."
(if (tramp-get-env-with-u-option v)
(setq env (append `("-u" ,elt) env))
(setq uenv (cons elt uenv))))))
+ (setenv-internal
+ env "INSIDE_EMACS"
+ (concat (or (getenv "INSIDE_EMACS") emacs-version)
+ ",tramp:" tramp-version)
+ 'keep)
(when env
(setq command
(format
@@ -3126,13 +3136,12 @@ STDERR can also be a file name."
;; directory.
(condition-case nil
(unwind-protect
- (setq ret
- (if (tramp-send-command-and-check
- v (format "cd %s && %s"
- (tramp-shell-quote-argument localname)
- command)
- t t)
- 0 1))
+ (setq ret (tramp-send-command-and-check
+ v (format
+ "cd %s && %s"
+ (tramp-shell-quote-argument localname) command)
+ t t t))
+ (unless (natnump ret) (setq ret 1))
;; We should add the output anyway.
(when outbuf
(with-current-buffer outbuf
@@ -3150,6 +3159,12 @@ STDERR can also be a file name."
(kill-buffer (tramp-get-connection-buffer v))
(setq ret 1)))
+ ;; Handle signals. `process-file-return-signal-string' exists
+ ;; since Emacs 28.1.
+ (when (and (bound-and-true-p process-file-return-signal-string)
+ (natnump ret) (>= ret 128))
+ (setq ret (nth (- ret 128) (tramp-get-signal-strings))))
+
;; Provide error file.
(when tmpstderr (rename-file tmpstderr (cadr destination) t))
@@ -4169,7 +4184,7 @@ file exists and nonzero exit status otherwise."
"exec env TERM='%s' INSIDE_EMACS='%s,tramp:%s' "
"ENV=%s %s PROMPT_COMMAND='' PS1=%s PS2='' PS3='' %s %s"))
tramp-terminal-type
- emacs-version tramp-version ; INSIDE_EMACS
+ (or (getenv "INSIDE_EMACS") emacs-version) tramp-version
(or (getenv-internal "ENV" tramp-remote-process-environment) "")
(if (stringp tramp-histfile-override)
(format "HISTFILE=%s"
@@ -4915,7 +4930,7 @@ If there is just some editing, retry it after 5 seconds."
(run-at-time 5 nil 'tramp-timeout-session vec))
(tramp-message
vec 3 "Timeout session %s" (tramp-make-tramp-file-name vec 'noloc))
- (tramp-cleanup-connection vec 'keep-debug)))
+ (tramp-cleanup-connection vec 'keep-debug nil 'keep-processes)))
(defun tramp-maybe-open-connection (vec)
"Maybe open a connection VEC.
@@ -5229,7 +5244,7 @@ function waits for output unless NOOUTPUT is set."
found)))
(defun tramp-send-command-and-check
- (vec command &optional subshell dont-suppress-err)
+ (vec command &optional subshell dont-suppress-err exit-status)
"Run COMMAND and check its exit status.
Send `echo $?' along with the COMMAND for checking the exit status.
If COMMAND is nil, just send `echo $?'. Return t if the exit
@@ -5237,7 +5252,9 @@ status is 0, and nil otherwise.
If the optional argument SUBSHELL is non-nil, the command is
executed in a subshell, ie surrounded by parentheses. If
-DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null."
+DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to /dev/null.
+Optional argument EXIT-STATUS, if non-nil, triggers the return of
+the exit status."
(tramp-send-command
vec
(concat (if subshell "( " "")
@@ -5251,7 +5268,9 @@ DONT-SUPPRESS-ERR is non-nil, stderr won't be sent to
/dev/null."
vec 'file-error "Couldn't find exit status of `%s'" command))
(skip-chars-forward "^ ")
(prog1
- (zerop (read (current-buffer)))
+ (if exit-status
+ (read (current-buffer))
+ (zerop (read (current-buffer))))
(let ((inhibit-read-only t))
(delete-region (match-beginning 0) (point-max))))))
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index c8fdc5d..ee263eb 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3783,7 +3783,8 @@ support symbolic links."
(defun tramp-handle-start-file-process (name buffer program &rest args)
"Like `start-file-process' for Tramp files.
BUFFER might be a list, in this case STDERR is separated."
- ;; `make-process' knows the `:file-handler' argument since Emacs 27.1 only.
+ ;; `make-process' knows the `:file-handler' argument since Emacs
+ ;; 27.1 only. Therefore, we invoke it via `tramp-file-name-handler'.
(tramp-file-name-handler
'make-process
:name name
@@ -4857,13 +4858,13 @@ verbosity of 6."
"Return t if system process PROCESS-NAME is running for `user-login-name'."
(when (stringp process-name)
(catch 'result
- (dolist (pid (tramp-compat-funcall 'list-system-processes))
- (let ((attributes (process-attributes pid)))
+ (dolist (pid (list-system-processes))
+ (when-let ((attributes (process-attributes pid))
+ (comm (cdr (assoc 'comm attributes))))
(and (string-equal (cdr (assoc 'user attributes)) (user-login-name))
- (when-let ((comm (cdr (assoc 'comm attributes))))
- ;; The returned command name could be truncated to 15
- ;; characters. Therefore, we cannot check for `string-equal'.
- (string-prefix-p comm process-name))
+ ;; The returned command name could be truncated to 15
+ ;; characters. Therefore, we cannot check for `string-equal'.
+ (string-prefix-p comm process-name)
(throw 'result t)))))))
(defun tramp-read-passwd (proc &optional prompt)
@@ -5046,6 +5047,23 @@ name of a process or buffer, or nil to default to the
current buffer."
(lambda ()
(remove-hook 'interrupt-process-functions #'tramp-interrupt-process))))
+(defun tramp-get-signal-strings ()
+ "Strings to return by `process-file' in case of signals."
+ ;; We use key nil for local connection properties.
+ (with-tramp-connection-property nil "signal-strings"
+ (let (result)
+ (if (and (stringp shell-file-name) (executable-find shell-file-name))
+ (dotimes (i 128)
+ (push
+ (if (= i 19) 1 ;; SIGSTOP
+ (call-process
+ shell-file-name nil nil nil "-c" (format "kill -%d $$" i)))
+ result))
+ (dotimes (i 128)
+ (push (format "Signal %d" i) result)))
+ ;; Due to Bug#41287, we cannot add this to the `dotimes' clause.
+ (reverse result))))
+
;; Checklist for `tramp-unload-hook'
;; - Unload all `tramp-*' packages
;; - Reset `file-name-handler-alist'
diff --git a/lisp/net/webjump.el b/lisp/net/webjump.el
index 6edd03c..8bb1561 100644
--- a/lisp/net/webjump.el
+++ b/lisp/net/webjump.el
@@ -1,4 +1,4 @@
-;;; webjump.el --- programmable Web hotlist
+;;; webjump.el --- programmable Web hotlist -*- lexical-binding: t; -*-
;; Copyright (C) 1996-1997, 2001-2020 Free Software Foundation, Inc.
@@ -323,8 +323,7 @@ Please submit bug reports and other feedback to the author,
Neil W. Van Dyke
(defun webjump-read-url-choice (what urls &optional default)
;; Note: Convert this to use `webjump-read-choice' someday.
- (let* ((completions (mapcar (function (lambda (n) (cons n n)))
- urls))
+ (let* ((completions (mapcar (lambda (n) (cons n n)) urls))
(input (completing-read (concat what
;;(if default " (RET for default)" "")
": ")
diff --git a/lisp/obsolete/ledit.el b/lisp/obsolete/ledit.el
deleted file mode 100644
index c99a06d..0000000
--- a/lisp/obsolete/ledit.el
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; ledit.el --- Emacs side of ledit interface
-
-;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: languages
-;; Obsolete-since: 24.3
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This is a major mode for editing Liszt.
-
-;;; Code:
-
-;;; To do:
-;;; o lisp -> emacs side of things (grind-definition and find-definition)
-
-(defvar ledit-mode-map nil)
-
-(defconst ledit-zap-file
- (expand-file-name (concat (user-login-name) ".l1") temporary-file-directory)
- "File name for data sent to Lisp by Ledit.")
-(defconst ledit-read-file
- (expand-file-name (concat (user-login-name) ".l2") temporary-file-directory)
- "File name for data sent to Ledit by Lisp.")
-(defconst ledit-compile-file
- (expand-file-name (concat (user-login-name) ".l4") temporary-file-directory)
- "File name for data sent to Lisp compiler by Ledit.")
-(defconst ledit-buffer "*LEDIT*"
- "Name of buffer in which Ledit accumulates data to send to Lisp.")
-
-;;;###autoload
-(defconst ledit-save-files t "\
-*Non-nil means Ledit should save files before transferring to Lisp.")
-;;;###autoload
-(defconst ledit-go-to-lisp-string "%?lisp" "\
-*Shell commands to execute to resume Lisp job.")
-;;;###autoload
-(defconst ledit-go-to-liszt-string "%?liszt" "\
-*Shell commands to execute to resume Lisp compiler job.")
-
-(defun ledit-save-defun ()
- "Save the current defun in the ledit buffer."
- (interactive)
- (save-excursion
- (end-of-defun)
- (let ((end (point)))
- (beginning-of-defun)
- (append-to-buffer ledit-buffer (point) end))
- (message "Current defun saved for Lisp")))
-
-(defun ledit-save-region (beg end)
- "Save the current region in the ledit buffer"
- (interactive "r")
- (append-to-buffer ledit-buffer beg end)
- (message "Region saved for Lisp"))
-
-(defun ledit-zap-defun-to-lisp ()
- "Carry the current defun to Lisp."
- (interactive)
- (ledit-save-defun)
- (ledit-go-to-lisp))
-
-(defun ledit-zap-defun-to-liszt ()
- "Carry the current defun to liszt."
- (interactive)
- (ledit-save-defun)
- (ledit-go-to-liszt))
-
-(defun ledit-zap-region-to-lisp (beg end)
- "Carry the current region to Lisp."
- (interactive "r")
- (ledit-save-region beg end)
- (ledit-go-to-lisp))
-
-(defun ledit-go-to-lisp ()
- "Suspend Emacs and restart a waiting Lisp job."
- (interactive)
- (if ledit-save-files
- (save-some-buffers))
- (if (get-buffer ledit-buffer)
- (with-current-buffer ledit-buffer
- (goto-char (point-min))
- (write-region (point-min) (point-max) ledit-zap-file)
- (erase-buffer)))
- (suspend-emacs ledit-go-to-lisp-string)
- (load ledit-read-file t t))
-
-(defun ledit-go-to-liszt ()
- "Suspend Emacs and restart a waiting Liszt job."
- (interactive)
- (if ledit-save-files
- (save-some-buffers))
- (if (get-buffer ledit-buffer)
- (with-current-buffer ledit-buffer
- (goto-char (point-min))
- (insert "(declare (macros t))\n")
- (write-region (point-min) (point-max) ledit-compile-file)
- (erase-buffer)))
- (suspend-emacs ledit-go-to-liszt-string)
- (load ledit-read-file t t))
-
-(defun ledit-setup ()
- "Set up key bindings for the Lisp/Emacs interface."
- (unless ledit-mode-map
- (setq ledit-mode-map (make-sparse-keymap))
- (set-keymap-parent ledit-mode-map lisp-mode-shared-map))
- (define-key ledit-mode-map "\e\^d" 'ledit-save-defun)
- (define-key ledit-mode-map "\e\^r" 'ledit-save-region)
- (define-key ledit-mode-map "\^xz" 'ledit-go-to-lisp)
- (define-key ledit-mode-map "\e\^c" 'ledit-go-to-liszt))
-
-(ledit-setup)
-
-;;;###autoload
-(defun ledit-mode ()
- "\\<ledit-mode-map>Major mode for editing text and stuffing it to a Lisp job.
-Like Lisp mode, plus these special commands:
- \\[ledit-save-defun] -- record defun at or after point
- for later transmission to Lisp job.
- \\[ledit-save-region] -- record region for later transmission to Lisp job.
- \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text.
- \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job
- and transmit saved text.
-
-\\{ledit-mode-map}
-To make Lisp mode automatically change to Ledit mode,
-do (setq lisp-mode-hook 'ledit-from-lisp-mode)"
- (interactive)
- (delay-mode-hooks (lisp-mode))
- (ledit-from-lisp-mode))
-
-;;;###autoload
-(defun ledit-from-lisp-mode ()
- (use-local-map ledit-mode-map)
- (setq mode-name "Ledit")
- (setq major-mode 'ledit-mode)
- (run-mode-hooks 'ledit-mode-hook))
-
-(provide 'ledit)
-
-;;; ledit.el ends here
diff --git a/lisp/obsolete/levents.el b/lisp/obsolete/levents.el
deleted file mode 100644
index 2ae1ca4..0000000
--- a/lisp/obsolete/levents.el
+++ /dev/null
@@ -1,292 +0,0 @@
-;;; levents.el --- emulate the Lucid event data type and associated functions
-
-;; Copyright (C) 1993, 2001-2020 Free Software Foundation, Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: emulations
-;; Obsolete-since: 23.2
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; Things we cannot emulate in Lisp:
-;; It is not possible to emulate current-mouse-event as a variable,
-;; though it is not hard to obtain the data from (this-command-keys).
-
-;; We do not have a variable unread-command-event;
-;; instead, we have the more general unread-command-events.
-
-;; Our read-key-sequence and read-char are not precisely
-;; compatible with those in Lucid Emacs, but they should work ok.
-
-;;; Code:
-
-(defun next-command-event (event)
- (error "You must rewrite to use `read-command-event' instead of
`next-command-event'"))
-
-(defun next-event (event)
- (error "You must rewrite to use `read-event' instead of `next-event'"))
-
-(defun dispatch-event (event)
- (error "`dispatch-event' not supported"))
-
-;; Make events of type eval, menu and timeout
-;; execute properly.
-
-(define-key global-map [menu] 'execute-eval-event)
-(define-key global-map [timeout] 'execute-eval-event)
-(define-key global-map [eval] 'execute-eval-event)
-
-(defun execute-eval-event (event)
- (interactive "e")
- (funcall (nth 1 event) (nth 2 event)))
-
-(put 'eval 'event-symbol-elements '(eval))
-(put 'menu 'event-symbol-elements '(eval))
-(put 'timeout 'event-symbol-elements '(eval))
-
-(defun allocate-event ()
- "Return an empty event structure.
-In this emulation, it returns nil."
- nil)
-
-(defun button-press-event-p (obj)
- "True if the argument is a mouse-button-press event object."
- (and (consp obj) (symbolp (car obj))
- (memq 'down (get (car obj) 'event-symbol-elements))))
-
-(defun button-release-event-p (obj)
- "True if the argument is a mouse-button-release event object."
- (and (consp obj) (symbolp (car obj))
- (or (memq 'click (get (car obj) 'event-symbol-elements))
- (memq 'drag (get (car obj) 'event-symbol-elements)))))
-
-(defun button-event-p (obj)
- "True if the argument is a mouse-button press or release event object."
- (and (consp obj) (symbolp (car obj))
- (or (memq 'click (get (car obj) 'event-symbol-elements))
- (memq 'down (get (car obj) 'event-symbol-elements))
- (memq 'drag (get (car obj) 'event-symbol-elements)))))
-
-(defun mouse-event-p (obj)
- "True if the argument is a mouse-button press or release event object."
- (and (consp obj) (symbolp (car obj))
- (or (eq (car obj) 'mouse-movement)
- (memq 'click (get (car obj) 'event-symbol-elements))
- (memq 'down (get (car obj) 'event-symbol-elements))
- (memq 'drag (get (car obj) 'event-symbol-elements)))))
-
-(defun character-to-event (ch &optional event)
- "Converts a numeric ASCII value to an event structure, replete with
-bucky bits. The character is the first argument, and the event to fill
-in is the second. This function contains knowledge about what the codes
-mean -- for example, the number 9 is converted to the character Tab,
-not the distinct character Control-I.
-
-Beware that character-to-event and event-to-character are not strictly
-inverse functions, since events contain much more information than the
-ASCII character set can encode."
- ch)
-
-(defun copy-event (event1 &optional event2)
- "Make a copy of the given event object.
-In this emulation, `copy-event' just returns its argument."
- event1)
-
-(defun deallocate-event (event)
- "Allow the given event structure to be reused.
-In actual Lucid Emacs, you MUST NOT use this event object after
-calling this function with it. You will lose. It is not necessary to
-call this function, as event objects are garbage- collected like all
-other objects; however, it may be more efficient to explicitly
-deallocate events when you are sure that this is safe.
-
-This emulation does not actually deallocate or reuse events
-except via garbage collection and `cons'."
- nil)
-
-(defun enqueue-eval-event: (function object)
- "Add an eval event to the back of the queue.
-It will be the next event read after all pending events."
- (setq unread-command-events
- (nconc unread-command-events
- (list (list 'eval function object)))))
-
-(defun eval-event-p (obj)
- "True if the argument is an eval or menu event object."
- (eq (car-safe obj) 'eval))
-
-(defun event-button (event)
- "Return the button-number of the given mouse-button-press event."
- (let ((sym (car (get (car event) 'event-symbol-elements))))
- (cdr (assq sym '((mouse-1 . 1) (mouse-2 . 2) (mouse-3 . 3)
- (mouse-4 . 4) (mouse-5 . 5))))))
-
-(defun event-function (event)
- "Return the callback function of the given timeout, menu, or eval event."
- (nth 1 event))
-
-(defun event-key (event)
- "Return the KeySym of the given key-press event.
-The value is an ASCII printing character (not upper case) or a symbol."
- (if (symbolp event)
- (car (get event 'event-symbol-elements))
- (let ((base (logand event (1- (ash 1 18)))))
- (downcase (if (< base 32) (logior base 64) base)))))
-
-(defun event-object (event)
- "Return the function argument of the given timeout, menu, or eval event."
- (nth 2 event))
-
-(defun event-point (event)
- "Return the character position of the given mouse-related event.
-If the event did not occur over a window, or did
-not occur over text, then this returns nil. Otherwise, it returns an index
-into the buffer visible in the event's window."
- (posn-point (event-end event)))
-
-;; Return position of start of line LINE in WINDOW.
-;; If LINE is nil, return the last position
-;; visible in WINDOW.
-(defun event-closest-point-1 (window &optional line)
- (let* ((total (- (window-height window)
- (if (window-minibuffer-p window)
- 0 1)))
- (distance (or line total)))
- (save-excursion
- (goto-char (window-start window))
- (if (= (vertical-motion distance) distance)
- (if (not line)
- (forward-char -1)))
- (point))))
-
-(defun event-closest-point (event &optional start-window)
- "Return the nearest position to where EVENT ended its motion.
-This is computed for the window where EVENT's motion started,
-or for window WINDOW if that is specified."
- (or start-window (setq start-window (posn-window (event-start event))))
- (if (eq start-window (posn-window (event-end event)))
- (if (eq (event-point event) 'vertical-line)
- (event-closest-point-1 start-window
- (cdr (posn-col-row (event-end event))))
- (if (eq (event-point event) 'mode-line)
- (event-closest-point-1 start-window)
- (event-point event)))
- ;; EVENT ended in some other window.
- (let* ((end-w (posn-window (event-end event)))
- (end-w-top)
- (w-top (nth 1 (window-edges start-window))))
- (setq end-w-top
- (if (windowp end-w)
- (nth 1 (window-edges end-w))
- (/ (cdr (posn-x-y (event-end event)))
- (frame-char-height end-w))))
- (if (>= end-w-top w-top)
- (event-closest-point-1 start-window)
- (window-start start-window)))))
-
-(defun event-process (event)
- "Return the process of the given process-output event."
- (nth 1 event))
-
-(defun event-timestamp (event)
- "Return the timestamp of the given event object.
-In Lucid Emacs, this works for any kind of event.
-In this emulation, it returns nil for non-mouse-related events."
- (and (listp event)
- (posn-timestamp (event-end event))))
-
-(defun event-to-character (event &optional lenient)
- "Return the closest ASCII approximation to the given event object.
-If the event isn't a keypress, this returns nil.
-If the second argument is non-nil, then this is lenient in its
-translation; it will ignore modifier keys other than control and meta,
-and will ignore the shift modifier on those characters which have no
-shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
-the same ASCII code as Control-A.) If the second arg is nil, then nil
-will be returned for events which have no direct ASCII equivalent."
- (if (symbolp event)
- (and lenient
- (cdr (assq event '((backspace . 8) (delete . 127) (tab . 9)
- (return . 10) (enter . 10)))))
- ;; Our interpretation is, ASCII means anything a number can represent.
- (if (integerp event)
- event nil)))
-
-(defun event-window (event)
- "Return the window of the given mouse-related event object."
- (posn-window (event-end event)))
-
-(defun event-x (event)
- "Return the X position in characters of the given mouse-related event."
- (/ (car (posn-col-row (event-end event)))
- (frame-char-width (window-frame (event-window event)))))
-
-(defun event-x-pixel (event)
- "Return the X position in pixels of the given mouse-related event."
- (car (posn-col-row (event-end event))))
-
-(defun event-y (event)
- "Return the Y position in characters of the given mouse-related event."
- (/ (cdr (posn-col-row (event-end event)))
- (frame-char-height (window-frame (event-window event)))))
-
-(defun event-y-pixel (event)
- "Return the Y position in pixels of the given mouse-related event."
- (cdr (posn-col-row (event-end event))))
-
-(defun key-press-event-p (obj)
- "True if the argument is a keyboard event object."
- (or (integerp obj)
- (and (symbolp obj)
- (get obj 'event-symbol-elements))))
-
-(defun menu-event-p (obj)
- "True if the argument is a menu event object."
- (eq (car-safe obj) 'menu))
-
-(defun motion-event-p (obj)
- "True if the argument is a mouse-motion event object."
- (eq (car-safe obj) 'mouse-movement))
-
-(defun read-command-event ()
- "Return the next keyboard or mouse event; execute other events.
-This is similar to the function `next-command-event' of Lucid Emacs,
-but different in that it returns the event rather than filling in
-an existing event object."
- (let (event)
- (while (progn
- (setq event (read-event))
- (not (or (key-press-event-p event)
- (button-press-event-p event)
- (button-release-event-p event)
- (menu-event-p event))))
- (let ((type (car-safe event)))
- (cond ((eq type 'eval)
- (funcall (nth 1 event) (nth 2 event)))
- ((eq type 'switch-frame)
- (select-frame (nth 1 event))))))
- event))
-
-(defun process-event-p (obj)
- "True if the argument is a process-output event object.
-GNU Emacs 19 does not currently generate process-output events."
- (eq (car-safe obj) 'process))
-
-(provide 'levents)
-
-;;; levents.el ends here
diff --git a/lisp/obsolete/lmenu.el b/lisp/obsolete/lmenu.el
deleted file mode 100644
index 6784819..0000000
--- a/lisp/obsolete/lmenu.el
+++ /dev/null
@@ -1,445 +0,0 @@
-;;; lmenu.el --- emulate Lucid's menubar support
-
-;; Copyright (C) 1992-1994, 1997, 2001-2020 Free Software Foundation,
-;; Inc.
-
-;; Keywords: emulations obsolete
-;; Obsolete-since: 23.3
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; This file has been obsolete since Emacs 23.3.
-
-;;; Code:
-
-
-;; First, emulate the Lucid menubar support in GNU Emacs 19.
-
-;; Arrange to use current-menubar to set up part of the menu bar.
-
-(defvar current-menubar)
-(defvar lucid-menubar-map)
-(defvar lucid-failing-menubar)
-
-(defvar recompute-lucid-menubar 'recompute-lucid-menubar)
-(defun recompute-lucid-menubar ()
- (define-key lucid-menubar-map [menu-bar]
- (condition-case nil
- (make-lucid-menu-keymap "menu-bar" current-menubar)
- (error (message "Invalid data in current-menubar moved to
lucid-failing-menubar")
- (sit-for 1)
- (setq lucid-failing-menubar current-menubar
- current-menubar nil))))
- (setq lucid-menu-bar-dirty-flag nil))
-
-(defvar lucid-menubar-map (make-sparse-keymap))
-(or (assq 'current-menubar minor-mode-map-alist)
- (setq minor-mode-map-alist
- (cons (cons 'current-menubar lucid-menubar-map)
- minor-mode-map-alist)))
-
-;; XEmacs compatibility
-(defun set-menubar-dirty-flag ()
- (force-mode-line-update)
- (setq lucid-menu-bar-dirty-flag t))
-
-(defvar add-menu-item-count 0)
-
-;; This is a variable whose value is always nil.
-(defvar make-lucid-menu-keymap-disable nil)
-
-;; Return a menu keymap corresponding to a Lucid-style menu list
-;; MENU-ITEMS, and with name MENU-NAME.
-(defun make-lucid-menu-keymap (menu-name menu-items)
- (let ((menu (make-sparse-keymap menu-name)))
- ;; Process items in reverse order,
- ;; since the define-key loop reverses them again.
- (setq menu-items (reverse menu-items))
- (while menu-items
- (let ((item (car menu-items))
- command name callback)
- (cond ((stringp item)
- (setq command nil)
- (setq name (if (string-match "^-+$" item) "" item)))
- ((consp item)
- (setq command (make-lucid-menu-keymap (car item) (cdr item)))
- (setq name (car item)))
- ((vectorp item)
- (setq command (make-symbol (format "menu-function-%d"
- add-menu-item-count))
- add-menu-item-count (1+ add-menu-item-count)
- name (aref item 0)
- callback (aref item 1))
- (if (symbolp callback)
- (fset command callback)
- (fset command (list 'lambda () '(interactive) callback)))
- (put command 'menu-alias t)
- (let ((i 2))
- (while (< i (length item))
- (cond
- ((eq (aref item i) ':active)
- (put command 'menu-enable
- (or (aref item (1+ i))
- 'make-lucid-menu-keymap-disable))
- (setq i (+ 2 i)))
- ((eq (aref item i) ':suffix)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':keys)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':style)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((eq (aref item i) ':selected)
- ;; unimplemented
- (setq i (+ 2 i)))
- ((and (symbolp (aref item i))
- (= ?: (string-to-char (symbol-name (aref item i)))))
- (error "Unrecognized menu item keyword: %S"
- (aref item i)))
- ((= i 2)
- ;; old-style format: active-p &optional suffix
- (put command 'menu-enable
- (or (aref item i) 'make-lucid-menu-keymap-disable))
- ;; suffix is unimplemented
- (setq i (length item)))
- (t
- (error "Unexpected menu item value: %S"
- (aref item i))))))))
- (if (null command)
- ;; Handle inactive strings specially--allow any number
- ;; of identical ones.
- (setcdr menu (cons (list nil name) (cdr menu)))
- (if name
- (define-key menu (vector (intern name)) (cons name command)))))
- (setq menu-items (cdr menu-items)))
- menu))
-
-(declare-function x-popup-dialog "menu.c" (position contents &optional header))
-
-;; XEmacs compatibility function
-(defun popup-dialog-box (data)
- "Pop up a dialog box.
-A dialog box description is a list.
-
- - The first element of the list is a string to display in the dialog box.
- - The rest of the elements are descriptions of the dialog box's buttons.
- Each one is a vector of three elements:
- - The first element is the text of the button.
- - The second element is the `callback'.
- - The third element is t or nil, whether this button is selectable.
-
-If the `callback' of a button is a symbol, then it must name a command.
-It will be invoked with `call-interactively'. If it is a list, then it is
-evaluated with `eval'.
-
-One (and only one) of the buttons may be nil. This marker means that all
-following buttons should be flushright instead of flushleft.
-
-The syntax, more precisely:
-
- form := <something to pass to `eval'>
- command := <a symbol or string, to pass to `call-interactively'>
- callback := command | form
- active-p := <t, nil, or a form to evaluate to decide whether this
- button should be selectable>
- name := <string>
- partition := `nil'
- button := `[' name callback active-p `]'
- dialog := `(' name [ button ]+ [ partition [ button ]+ ] `)'"
- (let ((name (car data))
- (tail (cdr data))
- converted
- choice meaning)
- (while tail
- (if (null (car tail))
- (setq converted (cons nil converted))
- (let ((item (aref (car tail) 0))
- (callback (aref (car tail) 1))
- (enable (aref (car tail) 2)))
- (setq converted
- (cons (if enable (cons item callback) item)
- converted))))
- (setq tail (cdr tail)))
- (setq choice (x-popup-dialog t (cons name (nreverse converted))))
- (if choice
- (if (symbolp choice)
- (call-interactively choice)
- (eval choice)))))
-
-;; This is empty because the usual elements of the menu bar
-;; are provided by menu-bar.el instead.
-;; It would not make sense to duplicate them here.
-(defconst default-menubar nil)
-
-;; XEmacs compatibility
-(defun set-menubar (menubar)
- "Set the default menubar to be menubar."
- (setq-default current-menubar (copy-sequence menubar))
- (set-menubar-dirty-flag))
-
-;; XEmacs compatibility
-(defun set-buffer-menubar (menubar)
- "Set the buffer-local menubar to be menubar."
- (make-local-variable 'current-menubar)
- (setq current-menubar (copy-sequence menubar))
- (set-menubar-dirty-flag))
-
-
-;;; menu manipulation functions
-
-;; XEmacs compatibility
-(defun find-menu-item (menubar item-path-list &optional parent)
- "Searches MENUBAR for item given by ITEM-PATH-LIST.
-Returns (ITEM . PARENT), where PARENT is the immediate parent of
- the item found.
-Signals an error if the item is not found."
- (or parent (setq item-path-list (mapcar 'downcase item-path-list)))
- (if (not (consp menubar))
- nil
- (let ((rest menubar)
- result)
- (while rest
- (if (and (car rest)
- (equal (car item-path-list)
- (downcase (if (vectorp (car rest))
- (aref (car rest) 0)
- (if (stringp (car rest))
- (car rest)
- (car (car rest)))))))
- (setq result (car rest) rest nil)
- (setq rest (cdr rest))))
- (if (cdr item-path-list)
- (if (consp result)
- (find-menu-item (cdr result) (cdr item-path-list) result)
- (if result
- (signal 'error (list "not a submenu" result))
- (signal 'error (list "no such submenu" (car item-path-list)))))
- (cons result parent)))))
-
-
-;; XEmacs compatibility
-(defun disable-menu-item (path)
- "Make the named menu item be unselectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (consp item) (error "can't disable menus, only menu items"))
- (aset item 2 nil)
- (set-menubar-dirty-flag)
- item))
-
-
-;; XEmacs compatibility
-(defun enable-menu-item (path)
- "Make the named menu item be selectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (consp item) (error "%S is a menu, not a menu item" path))
- (aset item 2 t)
- (set-menubar-dirty-flag)
- item))
-
-
-(defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before)
- (if before (setq before (downcase before)))
- (let* ((menubar current-menubar)
- (menu (condition-case ()
- (car (find-menu-item menubar menu-path))
- (error nil)))
- (item (if (listp menu)
- (car (find-menu-item (cdr menu) (list item-name)))
- (signal 'error (list "not a submenu" menu-path)))))
- (or menu
- (let ((rest menu-path)
- (so-far menubar))
- (while rest
-;;; (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
- (setq menu
- (if (eq so-far menubar)
- (car (find-menu-item so-far (list (car rest))))
- (car (find-menu-item (cdr so-far) (list (car rest))))))
- (or menu
- (let ((rest2 so-far))
- (or rest2
- (error "Trying to modify a menu that doesn't exist"))
- (while (and (cdr rest2) (car (cdr rest2)))
- (setq rest2 (cdr rest2)))
- (setcdr rest2
- (nconc (list (setq menu (list (car rest))))
- (cdr rest2)))))
- (setq so-far menu)
- (setq rest (cdr rest)))))
- (or menu (setq menu menubar))
- (if item
- nil ; it's already there
- (if item-p
- (setq item (vector item-name item-data enabled-p))
- (setq item (cons item-name item-data)))
- ;; if BEFORE is specified, try to add it there.
- (if before
- (setq before (car (find-menu-item menu (list before)))))
- (let ((rest menu)
- (added-before nil))
- (while rest
- (if (eq before (car (cdr rest)))
- (progn
- (setcdr rest (cons item (cdr rest)))
- (setq rest nil added-before t))
- (setq rest (cdr rest))))
- (if (not added-before)
- ;; adding before the first item on the menubar itself is harder
- (if (and (eq menu menubar) (eq before (car menu)))
- (setq menu (cons item menu)
- current-menubar menu)
- ;; otherwise, add the item to the end.
- (nconc menu (list item))))))
- (if item-p
- (progn
- (aset item 1 item-data)
- (aset item 2 (not (null enabled-p))))
- (setcar item item-name)
- (setcdr item item-data))
- (set-menubar-dirty-flag)
- item))
-
-;; XEmacs compatibility
-(defun add-menu-item (menu-path item-name function enabled-p &optional before)
- "Add a menu item to some menu, creating the menu first if necessary.
-If the named item exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu item should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
-ITEM-NAME is the string naming the menu item to be added.
-FUNCTION is the command to invoke when this menu item is selected.
- If it is a symbol, then it is invoked with `call-interactively', in the same
- way that functions bound to keys are invoked. If it is a list, then the
- list is simply evaluated.
-ENABLED-P controls whether the item is selectable or not.
-BEFORE, if provided, is the name of a menu item before which this item should
- be added, if this item is not on the menu already. If the item is already
- present, it will not be moved."
- (or menu-path (error "must specify a menu path"))
- (or item-name (error "must specify an item name"))
- (add-menu-item-1 t menu-path item-name function enabled-p before))
-
-
-;; XEmacs compatibility
-(defun delete-menu-item (path)
- "Remove the named menu item from the menu hierarchy.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (or (cdr pair) menubar)))
- (if (not item)
- nil
- ;; the menubar is the only special case, because other menus begin
- ;; with their name.
- (if (eq menu current-menubar)
- (setq current-menubar (delq item menu))
- (delq item menu))
- (set-menubar-dirty-flag)
- item)))
-
-
-;; XEmacs compatibility
-(defun relabel-menu-item (path new-name)
- "Change the string of the specified menu item.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy. (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu. (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
-NEW-NAME is the string that the menu item will be printed as from now on."
- (or (stringp new-name)
- (setq new-name (signal 'wrong-type-argument (list 'stringp new-name))))
- (let* ((menubar current-menubar)
- (pair (find-menu-item menubar path))
- (item (car pair))
- (menu (cdr pair)))
- (or item
- (signal 'error (list (if menu "No such menu item" "No such menu")
- path)))
- (if (and (consp item)
- (stringp (car item)))
- (setcar item new-name)
- (aset item 0 new-name))
- (set-menubar-dirty-flag)
- item))
-
-;; XEmacs compatibility
-(defun add-menu (menu-path menu-name menu-items &optional before)
- "Add a menu to the menubar or one of its submenus.
-If the named menu exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu. (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
- If MENU-PATH is nil, then the menu will be added to the menubar itself.
-MENU-NAME is the string naming the menu to be added.
-MENU-ITEMS is a list of menu item descriptions.
- Each menu item should be a vector of three elements:
- - a string, the name of the menu item;
- - a symbol naming a command, or a form to evaluate;
- - and a form whose value determines whether this item is selectable.
-BEFORE, if provided, is the name of a menu before which this menu should
- be added, if this menu is not on its parent already. If the menu is already
- present, it will not be moved."
- (or menu-name (error "must specify a menu name"))
- (or menu-items (error "must specify some menu items"))
- (add-menu-item-1 nil menu-path menu-name menu-items t before))
-
-
-
-(defvar put-buffer-names-in-file-menu t)
-
-
-;; Don't unconditionally enable menu bars; leave that up to the user.
-;;(let ((frames (frame-list)))
-;; (while frames
-;; (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
-;; (setq frames (cdr frames))))
-;;(or (assq 'menu-bar-lines default-frame-alist)
-;; (setq default-frame-alist
-;; (cons '(menu-bar-lines . 1) default-frame-alist)))
-
-(set-menubar default-menubar)
-
-(provide 'lmenu)
-
-;;; lmenu.el ends here
diff --git a/lisp/obsolete/lucid.el b/lisp/obsolete/lucid.el
deleted file mode 100644
index 817cc9c..0000000
--- a/lisp/obsolete/lucid.el
+++ /dev/null
@@ -1,211 +0,0 @@
-;;; lucid.el --- emulate some Lucid Emacs functions
-
-;; Copyright (C) 1993, 1995, 2001-2020 Free Software Foundation, Inc.
-
-;; Maintainer: emacs-devel@gnu.org
-;; Keywords: emulations
-;; Obsolete-since: 23.2
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; Code:
-
-;; XEmacs autoloads CL so we might as well make use of it.
-(require 'cl)
-
-(defalias 'current-time-seconds 'current-time)
-
-(defun real-path-name (name &optional default)
- (file-truename (expand-file-name name default)))
-
-;; It's not clear what to return if the mouse is not in FRAME.
-(defun read-mouse-position (frame)
- (let ((pos (mouse-position)))
- (if (eq (car pos) frame)
- (cdr pos))))
-
-(defun switch-to-other-buffer (arg)
- "Switch to the previous buffer.
-With a numeric arg N, switch to the Nth most recent buffer.
-With an arg of 0, buries the current buffer at the
-bottom of the buffer stack."
- (interactive "p")
- (if (eq arg 0)
- (bury-buffer (current-buffer)))
- (switch-to-buffer
- (if (<= arg 1) (other-buffer (current-buffer))
- (nth arg
- (apply 'nconc
- (mapcar
- (lambda (buf)
- (if (= ?\ (string-to-char (buffer-name buf)))
- nil
- (list buf)))
- (buffer-list)))))))
-
-(defun device-class (&optional device)
- "Return the class (color behavior) of DEVICE.
-This will be one of `color', `grayscale', or `mono'.
-This function exists for compatibility with XEmacs."
- (cond
- ((display-color-p device) 'color)
- ((display-grayscale-p device) 'grayscale)
- (t 'mono)))
-
-(defalias 'find-face 'facep)
-(defalias 'get-face 'facep)
-;; internal-try-face-font was removed from faces.el in rev 1.139, 1999/07/21.
-;;;(defalias 'try-face-font 'internal-try-face-font)
-
-(defalias 'exec-to-string 'shell-command-to-string)
-
-
-;; Buffer context
-
-(defun buffer-syntactic-context (&optional buffer)
- "Syntactic context at point in BUFFER.
-Either of `string', `comment' or nil.
-This is an XEmacs compatibility function."
- (with-current-buffer (or buffer (current-buffer))
- (let ((state (syntax-ppss (point))))
- (cond
- ((nth 3 state) 'string)
- ((nth 4 state) 'comment)))))
-
-
-(defun buffer-syntactic-context-depth (&optional buffer)
- "Syntactic parenthesis depth at point in BUFFER.
-This is an XEmacs compatibility function."
- (with-current-buffer (or buffer (current-buffer))
- (nth 0 (syntax-ppss (point)))))
-
-
-;; Extents
-(defun make-extent (beg end &optional buffer)
- (make-overlay beg end buffer))
-
-(defun extent-properties (extent) (overlay-properties extent))
-(unless (fboundp 'extent-property) (defalias 'extent-property 'overlay-get))
-
-(defun extent-at (pos &optional object property before)
- (with-current-buffer (or object (current-buffer))
- (let ((overlays (overlays-at pos 'sorted)))
- (when property
- (let (filtered)
- (while overlays
- (if (overlay-get (car overlays) property)
- (setq filtered (cons (car overlays) filtered)))
- (setq overlays (cdr overlays)))
- (setq overlays filtered)))
- (if before
- (nth 1 (memq before overlays))
- (car overlays)))))
-
-(defun set-extent-property (extent prop value)
- ;; Make sure that separate adjacent extents
- ;; with the same mouse-face value
- ;; do not run together as one extent.
- (and (eq prop 'mouse-face)
- (symbolp value)
- (setq value (list value)))
- (if (eq prop 'duplicable)
- (cond ((and value (not (overlay-get extent prop)))
- ;; If becoming duplicable, copy all overlayprops to text props.
- (add-text-properties (overlay-start extent)
- (overlay-end extent)
- (overlay-properties extent)
- (overlay-buffer extent)))
- ;; If becoming no longer duplicable, remove these text props.
- ((and (not value) (overlay-get extent prop))
- (remove-text-properties (overlay-start extent)
- (overlay-end extent)
- (overlay-properties extent)
- (overlay-buffer extent))))
- ;; If extent is already duplicable, put this property
- ;; on the text as well as on the overlay.
- (if (overlay-get extent 'duplicable)
- (put-text-property (overlay-start extent)
- (overlay-end extent)
- prop value (overlay-buffer extent))))
- (overlay-put extent prop value))
-
-(defun set-extent-face (extent face)
- (set-extent-property extent 'face face))
-
-(defun set-extent-end-glyph (extent glyph)
- (set-extent-property extent 'after-string glyph))
-
-(defun delete-extent (extent)
- (set-extent-property extent 'duplicable nil)
- (delete-overlay extent))
-
-;; Support the Lucid names with `screen' instead of `frame'.
-
-(defalias 'current-screen-configuration 'current-frame-configuration)
-(defalias 'delete-screen 'delete-frame)
-(defalias 'find-file-new-screen 'find-file-other-frame)
-(defalias 'find-file-read-only-new-screen 'find-file-read-only-other-frame)
-(defalias 'find-tag-new-screen 'find-tag-other-frame)
-;;(defalias 'focus-screen 'focus-frame)
-(defalias 'iconify-screen 'iconify-frame)
-(defalias 'mail-new-screen 'mail-other-frame)
-(defalias 'make-screen-invisible 'make-frame-invisible)
-(defalias 'make-screen-visible 'make-frame-visible)
-;; (defalias 'minibuffer-screen-list 'minibuffer-frame-list)
-(defalias 'modify-screen-parameters 'modify-frame-parameters)
-(defalias 'next-screen 'next-frame)
-;; (defalias 'next-multiscreen-window 'next-multiframe-window)
-;; (defalias 'previous-multiscreen-window 'previous-multiframe-window)
-;; (defalias 'redirect-screen-focus 'redirect-frame-focus)
-(defalias 'redraw-screen 'redraw-frame)
-;; (defalias 'screen-char-height 'frame-char-height)
-;; (defalias 'screen-char-width 'frame-char-width)
-;; (defalias 'screen-configuration-to-register
'frame-configuration-to-register)
-;; (defalias 'screen-focus 'frame-focus)
-(defalias 'screen-list 'frame-list)
-;; (defalias 'screen-live-p 'frame-live-p)
-(defalias 'screen-parameters 'frame-parameters)
-(defalias 'screen-pixel-height 'frame-pixel-height)
-(defalias 'screen-pixel-width 'frame-pixel-width)
-(defalias 'screen-root-window 'frame-root-window)
-(defalias 'screen-selected-window 'frame-selected-window)
-(defalias 'lower-screen 'lower-frame)
-(defalias 'raise-screen 'raise-frame)
-(defalias 'screen-visible-p 'frame-visible-p)
-(defalias 'screenp 'framep)
-(defalias 'select-screen 'select-frame)
-(defalias 'selected-screen 'selected-frame)
-;; (defalias 'set-screen-configuration 'set-frame-configuration)
-;; (defalias 'set-screen-height 'set-frame-height)
-(defalias 'set-screen-position 'set-frame-position)
-(defalias 'set-screen-size 'set-frame-size)
-;; (defalias 'set-screen-width 'set-frame-width)
-(defalias 'switch-to-buffer-new-screen 'switch-to-buffer-other-frame)
-;; (defalias 'unfocus-screen 'unfocus-frame)
-(defalias 'visible-screen-list 'visible-frame-list)
-(defalias 'window-screen 'window-frame)
-(defalias 'x-create-screen 'x-create-frame)
-(defalias 'x-new-screen 'make-frame)
-
-(provide 'lucid)
-
-;; Local Variables:
-;; byte-compile-warnings: (not cl-functions)
-;; End:
-
-;;; lucid.el ends here
diff --git a/lisp/mail/metamail.el b/lisp/obsolete/metamail.el
similarity index 99%
rename from lisp/mail/metamail.el
rename to lisp/obsolete/metamail.el
index 0e407ea..d6ab4a3 100644
--- a/lisp/mail/metamail.el
+++ b/lisp/obsolete/metamail.el
@@ -4,6 +4,7 @@
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
;; Keywords: mail, news, mime, multimedia
+;; Obsolete-since: 28.1
;; This file is part of GNU Emacs.
diff --git a/lisp/obsolete/old-whitespace.el b/lisp/obsolete/old-whitespace.el
deleted file mode 100644
index 2f46d7d..0000000
--- a/lisp/obsolete/old-whitespace.el
+++ /dev/null
@@ -1,801 +0,0 @@
-;;; whitespace.el --- warn about and clean bogus whitespaces in the file
-
-;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
-
-;; Author: Rajesh Vaidheeswarran <rv@gnu.org>
-;; Keywords: convenience
-;; Obsolete-since: 23.1
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; URL: http://www.dsmit.com/lisp/
-;;
-;; The whitespace library is intended to find and help fix five different types
-;; of whitespace problems that commonly exist in source code.
-;;
-;; 1. Leading space (empty lines at the top of a file).
-;; 2. Trailing space (empty lines at the end of a file).
-;; 3. Indentation space (8 or more spaces at beginning of line, that should be
-;; replaced with TABS).
-;; 4. Spaces followed by a TAB. (Almost always, we never want that).
-;; 5. Spaces or TABS at the end of a line.
-;;
-;; Whitespace errors are reported in a buffer, and on the mode line.
-;;
-;; Mode line will show a W:<x>!<y> to denote a particular type of whitespace,
-;; where `x' and `y' can be one (or more) of:
-;;
-;; e - End-of-Line whitespace.
-;; i - Indentation whitespace.
-;; l - Leading whitespace.
-;; s - Space followed by Tab.
-;; t - Trailing whitespace.
-;;
-;; If any of the whitespace checks is turned off, the mode line will display a
-;; !<y>.
-;;
-;; (since (3) is the most controversial one, here is the rationale: Most
-;; terminal drivers and printer drivers have TAB configured or even
-;; hardcoded to be 8 spaces. (Some of them allow configuration, but almost
-;; always they default to 8.)
-;;
-;; Changing `tab-width' to other than 8 and editing will cause your code to
-;; look different from within Emacs, and say, if you cat it or more it, or
-;; even print it.
-;;
-;; Almost all the popular programming modes let you define an offset (like
-;; c-basic-offset or perl-indent-level) to configure the offset, so you
-;; should never have to set your `tab-width' to be other than 8 in all
-;; these modes. In fact, with an indent level of say, 4, 2 TABS will cause
-;; Emacs to replace your 8 spaces with one \t (try it). If vi users in
-;; your office complain, tell them to use vim, which distinguishes between
-;; tabstop and shiftwidth (vi equivalent of our offsets), and also ask them
-;; to set smarttab.)
-;;
-;; All the above have caused (and will cause) unwanted codeline integration and
-;; merge problems.
-;;
-;; whitespace.el will complain if it detects whitespaces on opening a file, and
-;; warn you on closing a file also (in case you had inserted any
-;; whitespaces during the process of your editing).
-;;
-;; Exported functions:
-;;
-;; `whitespace-buffer' - To check the current buffer for whitespace problems.
-;; `whitespace-cleanup' - To cleanup all whitespaces in the current buffer.
-;; `whitespace-region' - To check between point and mark for whitespace
-;; problems.
-;; `whitespace-cleanup-region' - To cleanup all whitespaces between point
-;; and mark in the current buffer.
-
-;;; Code:
-
-(defvar whitespace-version "3.5" "Version of the whitespace library.")
-
-(defvar whitespace-all-buffer-files nil
- "An associated list of buffers and files checked for whitespace cleanliness.
-
-This is to enable periodic checking of whitespace cleanliness in the files
-visited by the buffers.")
-
-(defvar whitespace-rescan-timer nil
- "Timer object used to rescan the files in buffers that have been modified.")
-
-;; Tell Emacs about this new kind of minor mode
-(defvar whitespace-mode nil
- "Non-nil when Whitespace mode (a minor mode) is enabled.")
-(make-variable-buffer-local 'whitespace-mode)
-
-(defvar whitespace-mode-line nil
- "String to display in the mode line for Whitespace mode.")
-(make-variable-buffer-local 'whitespace-mode-line)
-
-(defvar whitespace-check-buffer-leading nil
- "Test leading whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-leading)
-;;;###autoload(put 'whitespace-check-buffer-leading 'safe-local-variable
'booleanp)
-
-(defvar whitespace-check-buffer-trailing nil
- "Test trailing whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-trailing)
-;;;###autoload(put 'whitespace-check-buffer-trailing 'safe-local-variable
'booleanp)
-
-(defvar whitespace-check-buffer-indent nil
- "Test indentation whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-indent)
-;;;###autoload(put 'whitespace-check-buffer-indent 'safe-local-variable
'booleanp)
-
-(defvar whitespace-check-buffer-spacetab nil
- "Test Space-followed-by-TABS whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-spacetab)
-;;;###autoload(put 'whitespace-check-buffer-spacetab 'safe-local-variable
'booleanp)
-
-(defvar whitespace-check-buffer-ateol nil
- "Test end-of-line whitespace for file in current buffer if t.")
-(make-variable-buffer-local 'whitespace-check-buffer-ateol)
-;;;###autoload(put 'whitespace-check-buffer-ateol 'safe-local-variable
'booleanp)
-
-(defvar whitespace-highlighted-space nil
- "The variable to store the extent to highlight.")
-(make-variable-buffer-local 'whitespace-highlighted-space)
-
-(defalias 'whitespace-make-overlay
- (if (featurep 'xemacs) 'make-extent 'make-overlay))
-(defalias 'whitespace-overlay-put
- (if (featurep 'xemacs) 'set-extent-property 'overlay-put))
-(defalias 'whitespace-delete-overlay
- (if (featurep 'xemacs) 'delete-extent 'delete-overlay))
-(defalias 'whitespace-overlay-start
- (if (featurep 'xemacs) 'extent-start 'overlay-start))
-(defalias 'whitespace-overlay-end
- (if (featurep 'xemacs) 'extent-end 'overlay-end))
-(defalias 'whitespace-mode-line-update
- (if (featurep 'xemacs) 'redraw-modeline 'force-mode-line-update))
-
-(defgroup whitespace nil
- "Check for and fix five different types of whitespaces in source code."
- :version "21.1"
- :link '(emacs-commentary-link "whitespace.el")
- ;; Since XEmacs doesn't have a 'convenience group, use the next best group
- ;; which is 'editing?
- :group (if (featurep 'xemacs) 'editing 'convenience))
-
-(defcustom whitespace-check-leading-whitespace t
- "Flag to check leading whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-leading'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-check-trailing-whitespace t
- "Flag to check trailing whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-trailing'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-check-spacetab-whitespace t
- "Flag to check space followed by a TAB. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-spacetab'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-spacetab-regexp "[ ]+\t"
- "Regexp to match one or more spaces followed by a TAB."
- :type 'regexp
- :group 'whitespace)
-
-(defcustom whitespace-check-indent-whitespace indent-tabs-mode
- "Flag to check indentation whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-indent'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-indent-regexp "^\t*\\( \\)+"
- "Regexp to match multiples of eight spaces near line beginnings.
-The default value ignores leading TABs."
- :type 'regexp
- :group 'whitespace)
-
-(defcustom whitespace-check-ateol-whitespace t
- "Flag to check end-of-line whitespace. This is the global for the system.
-It can be overridden by setting a buffer local variable
-`whitespace-check-buffer-ateol'."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-ateol-regexp "[ \t]+$"
- "Regexp to match one or more TABs or spaces at line ends."
- :type 'regexp
- :group 'whitespace)
-
-(defcustom whitespace-errbuf "*Whitespace Errors*"
- "The name of the buffer where whitespace related messages will be logged."
- :type 'string
- :group 'whitespace)
-
-(defcustom whitespace-clean-msg "clean."
- "If non-nil, this message will be displayed after a whitespace check
-determines a file to be clean."
- :type 'string
- :group 'whitespace)
-
-(defcustom whitespace-abort-on-error nil
- "While writing a file, abort if the file is unclean.
-If `whitespace-auto-cleanup' is set, that takes precedence over
-this variable."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-auto-cleanup nil
- "Cleanup a buffer automatically on finding it whitespace unclean."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-silent nil
- "All whitespace errors will be shown only in the mode line when t.
-
-Note that setting this may cause all whitespaces introduced in a file to go
-unnoticed when the buffer is killed, unless the user visits the `*Whitespace
-Errors*' buffer before opening (or closing) another file."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-modes '(ada-mode asm-mode autoconf-mode awk-mode
- c-mode c++-mode cc-mode
- change-log-mode cperl-mode
- electric-nroff-mode emacs-lisp-mode
- f90-mode fortran-mode html-mode
- html3-mode java-mode jde-mode
- ksh-mode latex-mode LaTeX-mode
- lisp-mode m4-mode makefile-mode
- modula-2-mode nroff-mode objc-mode
- pascal-mode perl-mode prolog-mode
- python-mode scheme-mode sgml-mode
- sh-mode shell-script-mode simula-mode
- tcl-mode tex-mode texinfo-mode
- vrml-mode xml-mode)
-
- "Major modes in which we turn on whitespace checking.
-
-These are mostly programming and documentation modes. But you may add other
-modes that you want whitespaces checked in by adding something like the
-following to your `.emacs':
-
-\(setq whitespace-modes (cons \\='my-mode (cons \\='my-other-mode
- whitespace-modes))\)
-
-Or, alternately, you can use the Emacs `customize' command to set this."
- :type '(repeat symbol)
- :group 'whitespace)
-
-(defcustom whitespace-rescan-timer-time 600
- "Period in seconds to rescan modified buffers for whitespace creep.
-
-This is the period after which the timer will fire causing
-`whitespace-rescan-files-in-buffers' to check for whitespace creep in
-modified buffers.
-
-To disable timer scans, set this to zero."
- :type 'integer
- :group 'whitespace)
-
-(defcustom whitespace-display-in-modeline t
- "Display whitespace errors on the modeline."
- :type 'boolean
- :group 'whitespace)
-
-(defcustom whitespace-display-spaces-in-color t
- "Display the bogus whitespaces by coloring them with the face
-`whitespace-highlight'."
- :type 'boolean
- :group 'whitespace)
-
-(defface whitespace-highlight '((((class color) (background light))
- (:background "green1"))
- (((class color) (background dark))
- (:background "sea green"))
- (((class grayscale mono)
- (background light))
- (:background "black"))
- (((class grayscale mono)
- (background dark))
- (:background "white")))
- "Face used for highlighting the bogus whitespaces that exist in the buffer."
- :group 'whitespace)
-
-(if (not (assoc 'whitespace-mode minor-mode-alist))
- (setq minor-mode-alist (cons '(whitespace-mode whitespace-mode-line)
- minor-mode-alist)))
-
-(set-default 'whitespace-check-buffer-leading
- whitespace-check-leading-whitespace)
-(set-default 'whitespace-check-buffer-trailing
- whitespace-check-trailing-whitespace)
-(set-default 'whitespace-check-buffer-indent
- whitespace-check-indent-whitespace)
-(set-default 'whitespace-check-buffer-spacetab
- whitespace-check-spacetab-whitespace)
-(set-default 'whitespace-check-buffer-ateol
- whitespace-check-ateol-whitespace)
-
-(defun whitespace-check-whitespace-mode (&optional arg)
- "Test and set the whitespace-mode in qualifying buffers."
- (if (null whitespace-mode)
- (setq whitespace-mode
- (if (or arg (member major-mode whitespace-modes))
- t
- nil))))
-
-;;;###autoload
-(defun whitespace-toggle-leading-check ()
- "Toggle the check for leading space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-leading))
- (setq whitespace-check-buffer-leading (not current-val))
- (message "Will%s check for leading space in buffer."
- (if whitespace-check-buffer-leading "" " not"))
- (if whitespace-check-buffer-leading (whitespace-buffer-leading))))
-
-;;;###autoload
-(defun whitespace-toggle-trailing-check ()
- "Toggle the check for trailing space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-trailing))
- (setq whitespace-check-buffer-trailing (not current-val))
- (message "Will%s check for trailing space in buffer."
- (if whitespace-check-buffer-trailing "" " not"))
- (if whitespace-check-buffer-trailing (whitespace-buffer-trailing))))
-
-;;;###autoload
-(defun whitespace-toggle-indent-check ()
- "Toggle the check for indentation space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-indent))
- (setq whitespace-check-buffer-indent (not current-val))
- (message "Will%s check for indentation space in buffer."
- (if whitespace-check-buffer-indent "" " not"))
- (if whitespace-check-buffer-indent
- (whitespace-buffer-search whitespace-indent-regexp))))
-
-;;;###autoload
-(defun whitespace-toggle-spacetab-check ()
- "Toggle the check for space-followed-by-TABs in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-spacetab))
- (setq whitespace-check-buffer-spacetab (not current-val))
- (message "Will%s check for space-followed-by-TABs in buffer."
- (if whitespace-check-buffer-spacetab "" " not"))
- (if whitespace-check-buffer-spacetab
- (whitespace-buffer-search whitespace-spacetab-regexp))))
-
-
-;;;###autoload
-(defun whitespace-toggle-ateol-check ()
- "Toggle the check for end-of-line space in the local buffer."
- (interactive)
- (let ((current-val whitespace-check-buffer-ateol))
- (setq whitespace-check-buffer-ateol (not current-val))
- (message "Will%s check for end-of-line space in buffer."
- (if whitespace-check-buffer-ateol "" " not"))
- (if whitespace-check-buffer-ateol
- (whitespace-buffer-search whitespace-ateol-regexp))))
-
-
-;;;###autoload
-(defun whitespace-buffer (&optional quiet)
- "Find five different types of white spaces in buffer.
-These are:
-1. Leading space \(empty lines at the top of a file).
-2. Trailing space \(empty lines at the end of a file).
-3. Indentation space \(8 or more spaces, that should be replaced with TABS).
-4. Spaces followed by a TAB. \(Almost always, we never want that).
-5. Spaces or TABS at the end of a line.
-
-Check for whitespace only if this buffer really contains a non-empty file
-and:
-1. the major mode is one of the whitespace-modes, or
-2. `whitespace-buffer' was explicitly called with a prefix argument."
- (interactive)
- (let ((whitespace-error nil))
- (whitespace-check-whitespace-mode current-prefix-arg)
- (if (and buffer-file-name (> (buffer-size) 0) whitespace-mode)
- (progn
- (whitespace-check-buffer-list (buffer-name) buffer-file-name)
- (whitespace-tickle-timer)
- (overlay-recenter (point-max))
- (remove-overlays nil nil 'face 'whitespace-highlight)
- (if whitespace-auto-cleanup
- (if buffer-read-only
- (if (not quiet)
- (message "Can't cleanup: %s is read-only" (buffer-name)))
- (whitespace-cleanup-internal))
- (let ((whitespace-leading (if whitespace-check-buffer-leading
- (whitespace-buffer-leading)
- nil))
- (whitespace-trailing (if whitespace-check-buffer-trailing
- (whitespace-buffer-trailing)
- nil))
- (whitespace-indent (if whitespace-check-buffer-indent
- (whitespace-buffer-search
- whitespace-indent-regexp)
- nil))
- (whitespace-spacetab (if whitespace-check-buffer-spacetab
- (whitespace-buffer-search
- whitespace-spacetab-regexp)
- nil))
- (whitespace-ateol (if whitespace-check-buffer-ateol
- (whitespace-buffer-search
- whitespace-ateol-regexp)
- nil))
- (whitespace-errmsg nil)
- (whitespace-filename buffer-file-name)
- (whitespace-this-modeline ""))
-
- ;; Now let's complain if we found any of the above.
- (setq whitespace-error (or whitespace-leading whitespace-indent
- whitespace-spacetab whitespace-ateol
- whitespace-trailing))
-
- (if whitespace-error
- (progn
- (setq whitespace-errmsg
- (concat whitespace-filename " contains:\n"
- (if whitespace-leading
- "Leading whitespace\n")
- (if whitespace-indent
- (concat "Indentation whitespace"
- whitespace-indent "\n"))
- (if whitespace-spacetab
- (concat "Space followed by Tab"
- whitespace-spacetab "\n"))
- (if whitespace-ateol
- (concat "End-of-line whitespace"
- whitespace-ateol "\n"))
- (if whitespace-trailing
- "Trailing whitespace\n")
- "\ntype `M-x whitespace-cleanup' to "
- "cleanup the file."))
- (setq whitespace-this-modeline
- (concat (if whitespace-ateol "e")
- (if whitespace-indent "i")
- (if whitespace-leading "l")
- (if whitespace-spacetab "s")
- (if whitespace-trailing "t")))))
- (whitespace-update-modeline whitespace-this-modeline)
- (if (get-buffer whitespace-errbuf)
- (kill-buffer whitespace-errbuf))
- (with-current-buffer (get-buffer-create whitespace-errbuf)
- (if whitespace-errmsg
- (progn
- (insert whitespace-errmsg)
- (if (not (or quiet whitespace-silent))
- (display-buffer (current-buffer) t))
- (if (not quiet)
- (message "Whitespaces: [%s%s] in %s"
- whitespace-this-modeline
- (let ((whitespace-unchecked
- (whitespace-unchecked-whitespaces)))
- (if whitespace-unchecked
- (concat "!" whitespace-unchecked)
- ""))
- whitespace-filename)))
- (if (and (not quiet) (not (equal whitespace-clean-msg "")))
- (message "%s %s" whitespace-filename
- whitespace-clean-msg))))))))
- whitespace-error))
-
-;;;###autoload
-(defun whitespace-region (s e)
- "Check the region for whitespace errors."
- (interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region s e)
- (whitespace-buffer))))
-
-;;;###autoload
-(defun whitespace-cleanup ()
- "Cleanup the five different kinds of whitespace problems.
-It normally applies to the whole buffer, but in Transient Mark mode
-when the mark is active it applies to the region.
-See `whitespace-buffer' docstring for a summary of the problems."
- (interactive)
- (if (and transient-mark-mode mark-active)
- (whitespace-cleanup-region (region-beginning) (region-end))
- (whitespace-cleanup-internal)))
-
-(defun whitespace-cleanup-internal (&optional region-only)
- ;; If this buffer really contains a file, then run, else quit.
- (whitespace-check-whitespace-mode current-prefix-arg)
- (if (and buffer-file-name whitespace-mode)
- (let ((whitespace-any nil)
- (whitespace-tabwidth 8)
- (whitespace-tabwidth-saved tab-width))
-
- ;; since all printable TABS should be 8, irrespective of how
- ;; they are displayed.
- (setq tab-width whitespace-tabwidth)
-
- (if (and whitespace-check-buffer-leading
- (whitespace-buffer-leading))
- (progn
- (whitespace-buffer-leading-cleanup)
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-trailing
- (whitespace-buffer-trailing))
- (progn
- (whitespace-buffer-trailing-cleanup)
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-indent
- (whitespace-buffer-search whitespace-indent-regexp))
- (progn
- (whitespace-indent-cleanup)
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-spacetab
- (whitespace-buffer-search whitespace-spacetab-regexp))
- (progn
- (whitespace-buffer-cleanup whitespace-spacetab-regexp "\t")
- (setq whitespace-any t)))
-
- (if (and whitespace-check-buffer-ateol
- (whitespace-buffer-search whitespace-ateol-regexp))
- (progn
- (whitespace-buffer-cleanup whitespace-ateol-regexp "")
- (setq whitespace-any t)))
-
- ;; Call this recursively till everything is taken care of
- (if whitespace-any
- (whitespace-cleanup-internal region-only)
- ;; if we are done, talk to the user
- (progn
- (unless whitespace-silent
- (if region-only
- (message "The region is now clean")
- (message "%s is now clean" buffer-file-name)))
- (whitespace-update-modeline)))
- (setq tab-width whitespace-tabwidth-saved))))
-
-;;;###autoload
-(defun whitespace-cleanup-region (s e)
- "Whitespace cleanup on the region."
- (interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region s e)
- (whitespace-cleanup-internal t))
- (whitespace-buffer t)))
-
-(defun whitespace-buffer-leading ()
- "Return t if the current buffer has leading newline characters.
-If highlighting is enabled, highlight these characters."
- (save-excursion
- (goto-char (point-min))
- (skip-chars-forward "\n")
- (unless (bobp)
- (whitespace-highlight-the-space (point-min) (point))
- t)))
-
-(defun whitespace-buffer-leading-cleanup ()
- "Remove any leading newline characters from current buffer."
- (save-excursion
- (goto-char (point-min))
- (skip-chars-forward "\n")
- (delete-region (point-min) (point))))
-
-(defun whitespace-buffer-trailing ()
- "Return t if the current buffer has extra trailing newline characters.
-If highlighting is enabled, highlight these characters."
- (save-excursion
- (goto-char (point-max))
- (skip-chars-backward "\n")
- (forward-line)
- (unless (eobp)
- (whitespace-highlight-the-space (point) (point-max))
- t)))
-
-(defun whitespace-buffer-trailing-cleanup ()
- "Remove extra trailing newline characters from current buffer."
- (save-excursion
- (goto-char (point-max))
- (skip-chars-backward "\n")
- (unless (eobp)
- (forward-line)
- (delete-region (point) (point-max)))))
-
-(defun whitespace-buffer-search (regexp)
- "Search for any given whitespace REGEXP."
- (with-local-quit
- (let (whitespace-retval)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (whitespace-highlight-the-space (match-beginning 0) (match-end 0))
- (push (match-beginning 0) whitespace-retval)))
- (when whitespace-retval
- (format " %s" (nreverse whitespace-retval))))))
-
-(defun whitespace-buffer-cleanup (regexp newregexp)
- "Search for any given whitespace REGEXP and replace it with the NEWREGEXP."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (replace-match newregexp))))
-
-(defun whitespace-indent-cleanup ()
- "Search for 8/more spaces at the start of a line and replace it with tabs."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward whitespace-indent-regexp nil t)
- (let ((column (current-column))
- (indent-tabs-mode t))
- (delete-region (match-beginning 0) (point))
- (indent-to column)))))
-
-(defun whitespace-unchecked-whitespaces ()
- "Return the list of whitespaces whose testing has been suppressed."
- (let ((unchecked-spaces
- (concat (if (not whitespace-check-buffer-ateol) "e")
- (if (not whitespace-check-buffer-indent) "i")
- (if (not whitespace-check-buffer-leading) "l")
- (if (not whitespace-check-buffer-spacetab) "s")
- (if (not whitespace-check-buffer-trailing) "t"))))
- (if (not (equal unchecked-spaces ""))
- unchecked-spaces
- nil)))
-
-(defun whitespace-update-modeline (&optional whitespace-err)
- "Update mode line with whitespace errors.
-Also with whitespaces whose testing has been turned off."
- (if whitespace-display-in-modeline
- (progn
- (setq whitespace-mode-line nil)
- ;; Whitespace errors
- (if (and whitespace-err (not (equal whitespace-err "")))
- (setq whitespace-mode-line whitespace-err))
- ;; Whitespace suppressed errors
- (let ((whitespace-unchecked (whitespace-unchecked-whitespaces)))
- (if whitespace-unchecked
- (setq whitespace-mode-line
- (concat whitespace-mode-line "!" whitespace-unchecked))))
- ;; Add the whitespace modeline prefix
- (setq whitespace-mode-line (if whitespace-mode-line
- (concat " W:" whitespace-mode-line)
- nil))
- (whitespace-mode-line-update))))
-
-(defun whitespace-highlight-the-space (b e)
- "Highlight the current line, unhighlighting a previously jumped to line."
- (if whitespace-display-spaces-in-color
- (let ((ol (whitespace-make-overlay b e)))
- (whitespace-overlay-put ol 'face 'whitespace-highlight))))
-
-(defun whitespace-unhighlight-the-space()
- "Unhighlight the currently highlight line."
- (if (and whitespace-display-spaces-in-color whitespace-highlighted-space)
- (progn
- (mapc 'whitespace-delete-overlay whitespace-highlighted-space)
- (setq whitespace-highlighted-space nil))))
-
-(defun whitespace-check-buffer-list (buf-name buf-file)
- "Add a buffer and its file to the whitespace monitor list.
-
-The buffer named BUF-NAME and its associated file BUF-FILE are now monitored
-periodically for whitespace."
- (if (and whitespace-mode (not (member (list buf-file buf-name)
- whitespace-all-buffer-files)))
- (add-to-list 'whitespace-all-buffer-files (list buf-file buf-name))))
-
-(defun whitespace-tickle-timer ()
- "Tickle timer to periodically to scan qualifying files for whitespace creep.
-
-If timer is not set, then set it to scan the files in
-`whitespace-all-buffer-files' periodically (defined by
-`whitespace-rescan-timer-time') for whitespace creep."
- (if (and whitespace-rescan-timer-time
- (/= whitespace-rescan-timer-time 0)
- (not whitespace-rescan-timer))
- (setq whitespace-rescan-timer
- (add-timeout whitespace-rescan-timer-time
- 'whitespace-rescan-files-in-buffers nil
- whitespace-rescan-timer-time))))
-
-(defun whitespace-rescan-files-in-buffers (&optional arg)
- "Check monitored files for whitespace creep since last scan."
- (let ((whitespace-all-my-files whitespace-all-buffer-files)
- buffile bufname thiselt buf)
- (if (not whitespace-all-my-files)
- (progn
- (disable-timeout whitespace-rescan-timer)
- (setq whitespace-rescan-timer nil))
- (while whitespace-all-my-files
- (setq thiselt (car whitespace-all-my-files))
- (setq whitespace-all-my-files (cdr whitespace-all-my-files))
- (setq buffile (car thiselt))
- (setq bufname (cadr thiselt))
- (setq buf (get-buffer bufname))
- (if (buffer-live-p buf)
- (with-current-buffer bufname
- ;;(message "buffer %s live" bufname)
- (if whitespace-mode
- (progn
- ;;(message "checking for whitespace in %s" bufname)
- (if whitespace-auto-cleanup
- (progn
- ;;(message "cleaning up whitespace in %s" bufname)
- (whitespace-cleanup-internal))
- (progn
- ;;(message "whitespace-buffer %s." (buffer-name))
- (whitespace-buffer t))))
- ;;(message "Removing %s from refresh list" bufname)
- (whitespace-refresh-rescan-list buffile bufname)))
- ;;(message "Removing %s from refresh list" bufname)
- (whitespace-refresh-rescan-list buffile bufname))))))
-
-(defun whitespace-refresh-rescan-list (buffile bufname)
- "Refresh the list of files to be rescanned for whitespace creep."
- (if whitespace-all-buffer-files
- (setq whitespace-all-buffer-files
- (delete (list buffile bufname) whitespace-all-buffer-files))
- (when whitespace-rescan-timer
- (disable-timeout whitespace-rescan-timer)
- (setq whitespace-rescan-timer nil))))
-
-;;;###autoload
-(defalias 'global-whitespace-mode 'whitespace-global-mode)
-
-;;;###autoload
-(define-minor-mode whitespace-global-mode
- "Toggle using Whitespace mode in new buffers.
-
-When this mode is active, `whitespace-buffer' is added to
-`find-file-hook' and `kill-buffer-hook'."
- :global t
- :group 'whitespace
- (if whitespace-global-mode
- (progn
- (add-hook 'find-file-hook 'whitespace-buffer)
- (add-hook 'write-file-functions 'whitespace-write-file-hook nil t)
- (add-hook 'kill-buffer-hook 'whitespace-buffer))
- (remove-hook 'find-file-hook 'whitespace-buffer)
- (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
- (remove-hook 'kill-buffer-hook 'whitespace-buffer)))
-
-;;;###autoload
-(defun whitespace-write-file-hook ()
- "Hook function to be called on the buffer when whitespace check is enabled.
-This is meant to be added buffer-locally to `write-file-functions'."
- (let ((werr nil))
- (if whitespace-auto-cleanup
- (whitespace-cleanup-internal)
- (setq werr (whitespace-buffer)))
- (if (and whitespace-abort-on-error werr)
- (error "Abort write due to whitespaces in %s"
- buffer-file-name)))
- nil)
-
-(defun whitespace-unload-function ()
- "Unload the whitespace library."
- (if (unintern "whitespace-unload-hook" obarray)
- ;; if whitespace-unload-hook is defined, let's get rid of it
- ;; and recursively call `unload-feature'
- (progn (unload-feature 'whitespace) t)
- ;; this only happens in the recursive call
- (whitespace-global-mode -1)
- (save-current-buffer
- (dolist (buf (buffer-list))
- (set-buffer buf)
- (remove-hook 'write-file-functions 'whitespace-write-file-hook t)))
- ;; continue standard unloading
- nil))
-
-(defun whitespace-unload-hook ()
- (remove-hook 'find-file-hook 'whitespace-buffer)
- (remove-hook 'write-file-functions 'whitespace-write-file-hook t)
- (remove-hook 'kill-buffer-hook 'whitespace-buffer))
-
-(add-hook 'whitespace-unload-hook 'whitespace-unload-hook)
-
-(provide 'whitespace)
-
-;;; whitespace.el ends here
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 5fe140d..689d134 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -2995,7 +2995,8 @@ Agenda views are separated by
`org-agenda-block-separator'."
(erase-buffer)
(insert (eval-when-compile
(let ((header
- "Press key for an agenda command:
+ (copy-sequence
+ "Press key for an agenda command:
-------------------------------- < Buffer, subtree/region restriction
a Agenda for current week or day > Remove restriction
t List of all TODO entries e Export agenda views
@@ -3004,7 +3005,7 @@ s Search for keywords M Like m, but
only TODO entries
/ Multi-occur S Like s, but only TODO entries
? Find :FLAGGED: entries C Configure custom agenda commands
* Toggle sticky agenda views # List stuck projects (!=configure)
-")
+"))
(start 0))
(while (string-match
"\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)"
diff --git a/lisp/password-cache.el b/lisp/password-cache.el
index 5e5f324..f500757 100644
--- a/lisp/password-cache.el
+++ b/lisp/password-cache.el
@@ -31,7 +31,8 @@
;; ;; Minibuffer prompt for password.
;; => "foo"
;;
-;; (password-cache-add "test" "foo")
+;; (password-cache-add "test" (read-passwd "Password? "))
+;; ;; Minibuffer prompt from read-passwd, which returns "foo".
;; => nil
;; (password-read "Password? " "test")
diff --git a/lisp/play/animate.el b/lisp/play/animate.el
index ff464b6..8dec551 100644
--- a/lisp/play/animate.el
+++ b/lisp/play/animate.el
@@ -1,4 +1,4 @@
-;;; animate.el --- make text dance
+;;; animate.el --- make text dance -*- lexical-binding:t -*-
;; Copyright (C) 2001-2020 Free Software Foundation, Inc.
@@ -84,7 +84,7 @@
(defun animate-place-char (char vpos hpos)
(goto-char (window-start))
(let (abbrev-mode)
- (dotimes (i vpos)
+ (dotimes (_ vpos)
(end-of-line)
(if (= (forward-line 1) 1)
(insert "\n"))))
diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el
index 3768a14..9a6300c 100644
--- a/lisp/play/dissociate.el
+++ b/lisp/play/dissociate.el
@@ -1,4 +1,4 @@
-;;; dissociate.el --- scramble text amusingly for Emacs
+;;; dissociate.el --- scramble text amusingly for Emacs -*- lexical-binding:t
-*-
;; Copyright (C) 1985, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/printing.el b/lisp/printing.el
index 181092e..b8879be 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -5622,8 +5622,6 @@ COMMAND.exe, COMMAND.bat and COMMAND.com in this order."
;; header
(let ((versions (concat "printing v" pr-version
" ps-print v" ps-print-version)))
- ;; to keep compatibility with Emacs 20 & 21:
- ;; DO NOT REPLACE `?\ ' BY `?\s'
(widget-insert (make-string (- 79 (length versions)) ?\ ) versions))
(pr-insert-italic "\nCurrent Directory : " 1)
(pr-insert-italic default-directory)
diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el
index 5d5811b..d12bed7 100644
--- a/lisp/progmodes/autoconf.el
+++ b/lisp/progmodes/autoconf.el
@@ -1,4 +1,4 @@
-;;; autoconf.el --- mode for editing Autoconf configure.ac files
+;;; autoconf.el --- mode for editing Autoconf configure.ac files -*-
lexical-binding: t; -*-
;; Copyright (C) 2000-2020 Free Software Foundation, Inc.
diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el
index f30477d..c49bdc5 100644
--- a/lisp/progmodes/cc-align.el
+++ b/lisp/progmodes/cc-align.el
@@ -790,6 +790,38 @@ arglist-cont-nonempty."
(or (c-lineup-assignments langelem)
c-basic-offset))
+(defun c-lineup-ternary-bodies (langelem)
+ "Line up true and false branches of a ternary operator (i.e. ‘?:’).
+More precisely, if the line starts with a colon which is a part of
+a said operator it with corresponding question mark; otherwise return
+nil. For example:
+
+ return arg % 2 == 0 ? arg / 2
+ : (3 * arg + 1); <- c-lineup-ternary-bodies
+
+Works with: arglist-cont, arglist-cont-nonempty and statement-cont.
+"
+ (save-excursion
+ (back-to-indentation)
+ (when (and (eq ?: (char-after))
+ (not (eq ?: (char-after (1+ (point))))))
+ (let ((limit (c-langelem-pos langelem)) (depth 1))
+ (catch 'done
+ (while (c-syntactic-skip-backward "^?:" limit t)
+ (goto-char (1- (point)))
+ (cond ((eq (char-after) ??)
+ ;; If we’ve found a question mark, decrease depth. If we’re
+ ;; reached zero, we’ve found the one we were looking for.
+ (when (zerop (setq depth (1- depth)))
+ (throw 'done (vector (current-column)))))
+ ((or (eq ?: (char-before)) (eq ?? (char-before)))
+ ;; Step over ‘::’ and ‘?:’ operators. We don’t have to
+ ;; handle ‘?:’ here but doing so saves an iteration.
+ (if (eq (point) limit)
+ (throw 'done nil)
+ (goto-char (1- (point)))))
+ ((setq depth (1+ depth)))))))))) ; Otherwise increase depth.
+
(defun c-lineup-cascaded-calls (langelem)
"Line up \"cascaded calls\" under each other.
If the line begins with \"->\" or \".\" and the preceding line ends
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index aa3f7d3..8c8296f 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -405,7 +405,7 @@ comment at the start of cc-engine.el for more info."
(when (and (car c-macro-cache)
(> (point) (car c-macro-cache)) ; in case we have a
; zero-sized region.
- (not (eq (char-before (1- (point))) ?\\)))
+ (not lim))
(setcdr c-macro-cache (point))
(setq c-macro-cache-syntactic nil)))))))
@@ -1642,6 +1642,21 @@ comment at the start of cc-engine.el for more info."
(forward-char 2)
t))))
+(defmacro c-forward-comment-minus-1 ()
+ "Call (forward-comment -1), taking care of escaped newlines.
+Return the result of `forward-comment' if it gets called, nil otherwise."
+ `(if (not comment-end-can-be-escaped)
+ (forward-comment -1)
+ (when (and (< (skip-syntax-backward " >") 0)
+ (eq (char-after) ?\n))
+ (forward-char))
+ (cond
+ ((and (eq (char-before) ?\n)
+ (eq (char-before (1- (point))) ?\\))
+ (backward-char)
+ nil)
+ (t (forward-comment -1)))))
+
(defun c-backward-single-comment ()
"Move backward past whitespace and the closest preceding comment, if any.
Return t if a comment was found, nil otherwise. In either case, the
@@ -1675,12 +1690,12 @@ This function does not do any hidden buffer changes."
;; same line.
(re-search-forward "\\=\\s *[\n\r]" start t)
- (if (if (forward-comment -1)
+ (if (if (c-forward-comment-minus-1)
(if (eolp)
;; If forward-comment above succeeded and we're at eol
;; then the newline we moved over above didn't end a
;; line comment, so we give it another go.
- (forward-comment -1)
+ (c-forward-comment-minus-1)
t))
;; Emacs <= 20 and XEmacs move back over the closer of a
@@ -1709,7 +1724,7 @@ comment at the start of cc-engine.el for more info."
(if (let (moved-comment)
(while
- (and (not (setq moved-comment (forward-comment -1)))
+ (and (not (setq moved-comment
(c-forward-comment-minus-1)))
;; Cope specifically with ^M^J here -
;; forward-comment sometimes gets stuck after ^Ms,
;; sometimes after ^M^J.
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 2cbbc66..9ea08a4 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -3016,6 +3016,84 @@ need for `pike-font-lock-extra-types'.")
(c-font-lock-doc-comments "/[*/]!" limit
autodoc-font-lock-doc-comments)))))
+;; Doxygen
+
+(defconst doxygen-font-lock-doc-comments
+ ;; TODO: Handle @code, @verbatim, @dot, @f etc. better by not highlighting
+ ;; text inside of those commands. Something smarter than just regexes may be
+ ;; needed to do that efficiently.
+ `((,(concat
+ ;; Make sure that the special character has not been escaped. E.g. in
+ ;; ‘\@foo’ only ‘\@’ is a command (similarly for other characters like
+ ;; ‘\\foo’, ‘\<foo’ and ‘\&foo’). The downside now is that we don’t
+ ;; match command started just after an escaped character, e.g. in
+ ;; ‘\@\foo’ we should match ‘\@’ as well as ‘\foo’ but only the former
+ ;; is matched.
+ "\\(?:^\\|[^\\@]\\)\\("
+ ;; Doxygen commands start with backslash or an at sign. Note that for
+ ;; brevity in the comments only ‘\’ will be mentioned.
+ "[\\@]\\(?:"
+ ;; Doxygen commands except those starting with ‘f’
+ "[a-eg-z][a-z]*"
+ ;; Doxygen command starting with ‘f’:
+ "\\|f\\(?:"
+ "[][$}]" ; \f$ \f} \f[ \f]
+ "\\|{\\(?:[a-zA-Z]+\\*?}{?\\)?" ; \f{ \f{env} \f{env}{
+ "\\|[a-z]+" ; \foo
+ "\\)"
+ "\\|~[a-zA-Z]*" ; \~ \~language
+ "\\|[$@&~<=>#%\".|\\\\]" ; single-character escapes
+ "\\|::\\|---?" ; \:: \-- \---
+ "\\)"
+ ;; HTML tags and entities:
+ "\\|</?\\sw\\(?:\\sw\\|\\s \\|[=\n\r*.:]\\|\"[^\"]*\"\\|'[^']*'\\)*>"
+ "\\|&\\(?:\\sw+\\|#[0-9]+\\|#x[0-9a-fA-F]+\\);"
+ "\\)")
+ 1 ,c-doc-markup-face-name prepend nil)
+ ;; Commands inside of strings are not commands so override highlighting
with
+ ;; string face. This also affects HTML attribute values if they are
+ ;; surrounded with double quotes which may or may not be considered a good
+ ;; thing.
+ ("\\(?:^\\|[^\\@]\\)\\(\"[^\"[:cntrl:]]+\"\\)"
+ 1 font-lock-string-face prepend nil)
+ ;; HTML comments inside of the Doxygen comments.
+ ("\\(?:^\\|[^\\@]\\)\\(<!--.*?-->\\)"
+ 1 font-lock-comment-face prepend nil)
+ ;; Autolinking. Doxygen auto-links anything that is a class name but we
have
+ ;; no hope of matching those. We are, however, able to match functions and
+ ;; members using explicit scoped syntax. For functions, we can also find
+ ;; them by noticing argument-list. Note that Doxygen accepts ‘::’ as well
+ ;; as ‘#’ as scope operators.
+ (,(let* ((ref "[\\@]ref\\s-+")
+ (ref-opt (concat "\\(?:" ref "\\)?"))
+ (id "[a-zA-Z_][a-zA-Z_0-9]*")
+ (args "\\(?:()\\|([^()]*)\\)")
+ (scope "\\(?:#\\|::\\)"))
+ (concat
+ "\\(?:^\\|[^\\@/%:]\\)\\(?:"
+ ref-opt "\\(?1:" scope "?" "\\(?:" id scope "\\)+" "~?" id
"\\)"
+ "\\|" ref-opt "\\(?1:" scope "~?" id "\\)"
+ "\\|" ref-opt "\\(?1:" scope "?" "~?" id "\\)" args
+ "\\|" ref "\\(?1:" "~?" id "\\)"
+ "\\|" ref-opt "\\(?1:~[A-Z][a-zA-Z0-9_]+\\)"
+ "\\)"))
+ 1 font-lock-function-name-face prepend nil)
+ ;; Match URLs and emails. This has two purposes. First of all, Doxygen
+ ;; autolinks URLs. Second of all, ‘@bar’ in ‘foo@bar.baz’ has been matched
+ ;; above as a command; try and overwrite it.
+ (,(let* ((host "[A-Za-z0-9]\\(?:[A-Za-z0-9-]\\{0,61\\}[A-Za-z0-9]\\)")
+ (fqdn (concat "\\(?:" host "\\.\\)+" host))
+ (comp "[!-(*--/-=?-~]+")
+ (path (concat "/\\(?:" comp "[.]+" "\\)*" comp)))
+ (concat "\\(?:mailto:\\)?[a-zA-0_.]+@" fqdn
+ "\\|https?://" fqdn "\\(?:" path "\\)?"))
+ 0 font-lock-keyword-face prepend nil)))
+
+(defconst doxygen-font-lock-keywords
+ `((,(lambda (limit)
+ (c-font-lock-doc-comments "/\\(?:/[/!]\\|\\*[\\*!]\\)"
+ limit doxygen-font-lock-doc-comments)))))
+
;; 2006-07-10: awk-font-lock-keywords has been moved back to cc-awk.el.
(cc-provide 'cc-fonts)
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index 1e72352..dcffc0d 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -1174,7 +1174,7 @@ since CC Mode treats every identifier as an expression."
;; Exception.
,@(when (c-major-mode-is 'c++-mode)
- '((prefix "throw")))
+ '((prefix "throw" "co_await" "co_yield")))
;; Sequence.
(left-assoc ","))
@@ -2040,6 +2040,7 @@ the appropriate place for that."
(c-lang-defconst c-return-kwds
"Keywords which return a value to the calling function."
t '("return")
+ c++ '("return" "co_return")
idl nil)
(c-lang-defconst c-return-key
@@ -2415,7 +2416,8 @@ If any of these also are on `c-type-list-kwds',
`c-ref-list-kwds',
`c-<>-type-kwds', or `c-<>-arglist-kwds' then the associated clauses
will be handled."
t nil
- objc '("@class" "@end" "@defs")
+ objc '("@class" "@defs" "@end" "@property" "@dynamic" "@synthesize"
+ "@compatibility_alias")
java '("import" "package")
pike '("import" "inherit"))
@@ -2538,7 +2540,8 @@ one of `c-type-list-kwds', `c-ref-list-kwds',
"Access protection label keywords in classes."
t nil
c++ '("private" "protected" "public")
- objc '("@private" "@protected" "@public"))
+ objc '("@private" "@protected" "@package" "@public"
+ "@required" "@optional"))
(c-lang-defconst c-protection-key
;; A regexp match an element of `c-protection-kwds' cleanly.
@@ -2753,7 +2756,7 @@ identifiers that follows the type in a normal
declaration."
"Statement keywords followed directly by a substatement."
t '("do" "else")
c++ '("do" "else" "try")
- objc '("do" "else" "@finally" "@try")
+ objc '("do" "else" "@finally" "@try" "@autoreleasepool")
java '("do" "else" "finally" "try")
idl nil)
@@ -2822,6 +2825,7 @@ Keywords here should also be in `c-block-stmt-1-kwds'."
(c-lang-defconst c-simple-stmt-kwds
"Statement keywords followed by an expression or nothing."
t '("break" "continue" "goto" "return")
+ c++ '("break" "continue" "goto" "return" "co_return")
objc '("break" "continue" "goto" "return" "@throw")
;; Note: `goto' is not valid in Java, but the keyword is still reserved.
java '("break" "continue" "goto" "return" "throw")
@@ -2895,7 +2899,8 @@ This construct is \"<keyword> <expression> :\"."
c++ (append
'("nullptr")
(c-lang-const c-constant-kwds c))
- objc '("nil" "Nil" "YES" "NO" "NS_DURING" "NS_HANDLER" "NS_ENDHANDLER")
+ objc '("nil" "Nil" "YES" "NO" "IBAction" "IBOutlet"
+ "NS_DURING" "NS_HANDLER" "NS_ENDHANDLER")
idl '("TRUE" "FALSE")
java '("true" "false" "null") ; technically "literals", not keywords
pike '("UNDEFINED")) ;; Not a keyword, but practically works as one.
@@ -3412,8 +3417,14 @@ regexp should match \"(\" if parentheses are valid in
declarators.
The end of the first submatch is taken as the end of the operator.
Identifier syntax is in effect when this is matched (see
`c-identifier-syntax-table')."
- t (if (c-lang-const c-type-modifier-kwds)
- (concat (regexp-opt (c-lang-const c-type-modifier-kwds) t) "\\>")
+ t (if (or (c-lang-const c-type-modifier-kwds) (c-lang-const c-modifier-kwds))
+ (concat
+ (regexp-opt (c--delete-duplicates
+ (append (c-lang-const c-type-modifier-kwds)
+ (c-lang-const c-modifier-kwds))
+ :test 'string-equal)
+ t)
+ "\\>")
;; Default to a regexp that never matches.
regexp-unmatchable)
;; Check that there's no "=" afterwards to avoid matching tokens
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index f92d3ef..b3b2374 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -795,7 +795,7 @@ compatible with old code; callers should always specify it."
(set (make-local-variable 'outline-level) 'c-outline-level)
(set (make-local-variable 'add-log-current-defun-function)
(lambda ()
- (or (c-cpp-define-name) (c-defun-name))))
+ (or (c-cpp-define-name) (car (c-defun-name-and-limits nil)))))
(let ((rfn (assq mode c-require-final-newline)))
(when rfn
(if (boundp 'mode-require-final-newline)
@@ -1431,7 +1431,7 @@ Note that the style variables are always made local to
the buffer."
;; Move to end of logical line (as it will be after the change, or as it
;; was before unescaping a NL.)
- (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*" nil t)
+ (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*" nil t)
;; We're at an EOLL or point-max.
(if (equal (c-get-char-property (point) 'syntax-table) '(15))
(if (memq (char-after) '(?\n ?\r))
@@ -1539,7 +1539,7 @@ Note that the style variables are always made local to
the buffer."
(progn
(goto-char (min (1+ end) ; 1+, in case a NL has become escaped.
(point-max)))
- (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*"
+ (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
nil t)
(point))
c-new-END))
@@ -1620,8 +1620,8 @@ Note that the style variables are always made local to
the buffer."
(c-beginning-of-macro))))
(goto-char (1+ end)) ; After the \
;; Search forward for EOLL
- (setq lim (re-search-forward "\\(\\\\\\(.\\|\n\\)\\|[^\\\n\r]\\)*"
- nil t))
+ (setq lim (re-search-forward "\\(?:\\\\\\(?:.\\|\n\\)\\|[^\\\n\r]\\)*"
+ nil t))
(goto-char (1+ end))
(when (c-search-forward-char-property-with-value-on-char
'syntax-table '(15) ?\" lim)
@@ -2541,13 +2541,21 @@ Key bindings:
(defconst c-or-c++-mode--regexp
(eval-when-compile
- (let ((id "[a-zA-Z0-9_]+") (ws "[ \t\r]+") (ws-maybe "[ \t\r]*"))
+ (let ((id "[a-zA-Z_][a-zA-Z0-9_]*") (ws "[ \t\r]+") (ws-maybe "[ \t\r]*")
+ (headers '("string" "string_view" "iostream" "map" "unordered_map"
+ "set" "unordered_set" "vector" "tuple")))
(concat "^" ws-maybe "\\(?:"
- "using" ws "\\(?:namespace" ws "std;\\|std::\\)"
- "\\|" "namespace" "\\(:?" ws id "\\)?" ws-maybe "{"
- "\\|" "class" ws id ws-maybe "[:{\n]"
- "\\|" "template" ws-maybe "<.*>"
- "\\|" "#include" ws-maybe "<\\(?:string\\|iostream\\|map\\)>"
+ "using" ws "\\(?:namespace" ws
+ "\\|" id "::"
+ "\\|" id ws-maybe "=\\)"
+ "\\|" "\\(?:inline" ws "\\)?namespace"
+ "\\(:?" ws "\\(?:" id "::\\)*" id "\\)?" ws-maybe "{"
+ "\\|" "class" ws id
+ "\\(?:" ws "final" "\\)?" ws-maybe "[:{;\n]"
+ "\\|" "struct" ws id "\\(?:" ws "final" ws-maybe "[:{\n]"
+ "\\|" ws-maybe ":\\)"
+ "\\|" "template" ws-maybe "<.*?>"
+ "\\|" "#include" ws-maybe "<" (regexp-opt headers) ">"
"\\)")))
"A regexp applied to C header files to check if they are really C++.")
@@ -2563,6 +2571,7 @@ should be used.
This function attempts to use file contents to determine whether
the code is C or C++ and based on that chooses whether to enable
`c-mode' or `c++-mode'."
+ (interactive)
(if (save-excursion
(save-restriction
(save-match-data
diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el
index 3995b21..b885f6a 100644
--- a/lisp/progmodes/cc-vars.el
+++ b/lisp/progmodes/cc-vars.el
@@ -576,6 +576,7 @@ comment styles:
javadoc -- Javadoc style for \"/** ... */\" comments (default in Java mode).
autodoc -- Pike autodoc style for \"//! ...\" comments (default in Pike mode).
gtkdoc -- GtkDoc style for \"/** ... **/\" comments (default in C and C++
modes).
+ doxygen -- Doxygen style.
The value may also be a list of doc comment styles, in which case all
of them are recognized simultaneously (presumably with markup cues
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 28e7667..08cf802 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -4975,8 +4975,6 @@ killed after process termination."
(defun ebnf-eps-filename (str)
(let* ((len (length str))
(stri 0)
- ;; to keep compatibility with Emacs 20 & 21:
- ;; DO NOT REPLACE `?\ ' BY `?\s'
(new (make-string len ?\ )))
(while (< stri len)
(aset new stri (aref ebnf-map-name (aref str stri)))
@@ -5993,8 +5991,6 @@ killed after process termination."
(defun ebnf-trim-right (str)
(let* ((len (1- (length str)))
(index len))
- ;; to keep compatibility with Emacs 20 & 21:
- ;; DO NOT REPLACE `?\ ' BY `?\s'
(while (and (> index 0) (= (aref str index) ?\ ))
(setq index (1- index)))
(if (= index len)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index f85fd77..d37eb8c 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -250,7 +250,7 @@ Comments in the form will be lost."
map))
;;;###autoload
-(define-derived-mode emacs-lisp-mode prog-mode
+(define-derived-mode emacs-lisp-mode lisp-data-mode
`("ELisp"
(lexical-binding (:propertize "/l"
help-echo "Using lexical-binding mode")
@@ -268,35 +268,26 @@ Blank lines separate paragraphs. Semicolons start
comments.
\\{emacs-lisp-mode-map}"
:group 'lisp
(defvar project-vc-external-roots-function)
- (lisp-mode-variables nil nil 'elisp)
+ (setcar font-lock-defaults
+ '(lisp-el-font-lock-keywords
+ lisp-el-font-lock-keywords-1
+ lisp-el-font-lock-keywords-2))
+ (setf (nth 2 font-lock-defaults) nil)
(add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
(if (boundp 'electric-pair-text-pairs)
(setq-local electric-pair-text-pairs
(append '((?\` . ?\') (?\‘ . ?\’))
electric-pair-text-pairs))
(add-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
- (setq-local electric-quote-string t)
- (setq imenu-case-fold-search nil)
(add-hook 'eldoc-documentation-functions
#'elisp-eldoc-documentation-function nil t)
(add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
(setq-local project-vc-external-roots-function #'elisp-load-path-roots)
(add-hook 'completion-at-point-functions
#'elisp-completion-at-point nil 'local)
- ;; .dir-locals.el and lock files will cause the byte-compiler and
- ;; checkdoc emit spurious warnings, because they don't follow the
- ;; conventions of Emacs Lisp sources. Until we have a better fix,
- ;; like teaching elisp-mode about files that only hold data
- ;; structures, we disable the ELisp Flymake backend for these files.
- (unless
- (let* ((bfname (buffer-file-name))
- (fname (and (stringp bfname) (file-name-nondirectory bfname))))
- (and (stringp fname)
- (or (string-match "\\`\\.#" fname)
- (string-equal dir-locals-file fname))))
- (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
- (add-hook 'flymake-diagnostic-functions
- #'elisp-flymake-byte-compile nil t)))
+ (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
+ (add-hook 'flymake-diagnostic-functions
+ #'elisp-flymake-byte-compile nil t))
;; Font-locking support.
@@ -664,18 +655,16 @@ functions are annotated with \"<f>\" via the
;; WORKAROUND: This is nominally a constant, but the text properties
;; are not preserved thru dump if use defconst. See bug#21237.
(defvar elisp--xref-format
- (let ((str "(%s %s)"))
- (put-text-property 1 3 'face 'font-lock-keyword-face str)
- (put-text-property 4 6 'face 'font-lock-function-name-face str)
- str))
+ #("(%s %s)"
+ 1 3 (face font-lock-keyword-face)
+ 4 6 (face font-lock-function-name-face)))
;; WORKAROUND: This is nominally a constant, but the text properties
;; are not preserved thru dump if use defconst. See bug#21237.
(defvar elisp--xref-format-extra
- (let ((str "(%s %s %s)"))
- (put-text-property 1 3 'face 'font-lock-keyword-face str)
- (put-text-property 4 6 'face 'font-lock-function-name-face str)
- str))
+ #("(%s %s %s)"
+ 1 3 (face font-lock-keyword-face)
+ 4 6 (face font-lock-function-name-face)))
(defvar find-feature-regexp);; in find-func.el
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 7fca9da..4ca5c65 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -5,8 +5,11 @@
;; Author: Pavel Kobyakov <pk_at_work@yahoo.com>
;; Maintainer: João Távora <joaotavora@gmail.com>
;; Version: 1.0.8
-;; Package-Requires: ((emacs "26.1"))
;; Keywords: c languages tools
+;; Package-Requires: ((emacs "26.1"))
+
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -313,9 +316,10 @@ generated it."
&optional data
overlay-properties)
"Make a Flymake diagnostic for BUFFER's region from BEG to END.
-TYPE is a key to symbol and TEXT is a description of the problem
-detected in this region. DATA is any object that the caller
-wishes to attach to the created diagnostic for later retrieval.
+TYPE is a diagnostic symbol and TEXT is string describing the
+problem detected in this region. DATA is any object that the
+caller wishes to attach to the created diagnostic for later
+retrieval.
OVERLAY-PROPERTIES is an alist of properties attached to the
created diagnostic, overriding the default properties and any
diff --git a/lisp/progmodes/glasses.el b/lisp/progmodes/glasses.el
index cad74f9..ab65a15 100644
--- a/lisp/progmodes/glasses.el
+++ b/lisp/progmodes/glasses.el
@@ -1,4 +1,4 @@
-;;; glasses.el --- make cantReadThis readable
+;;; glasses.el --- make cantReadThis readable -*- lexical-binding: t; -*-
;; Copyright (C) 1999-2020 Free Software Foundation, Inc.
@@ -66,7 +66,6 @@ defined by `glasses-original-separator'. If you don't want
to add missing
separators, set `glasses-separator' to an empty string. If you don't want to
replace existent separators, set `glasses-original-separator' to an empty
string."
- :group 'glasses
:type 'string
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -78,7 +77,6 @@ For instance, if you set it to \"_\" and set
`glasses-separator' to \"-\",
underscore separators are displayed as hyphens.
If `glasses-original-separator' is an empty string, no such display change is
performed."
- :group 'glasses
:type 'string
:set 'glasses-custom-set
:initialize 'custom-initialize-default
@@ -92,7 +90,6 @@ If it is nil, no face is placed at the capitalized letter.
For example, you can set `glasses-separator' to an empty string and
`glasses-face' to `bold'. Then unreadable identifiers will have no separators,
but will have their capitals in bold."
- :group 'glasses
:type '(choice (const :tag "None" nil) face)
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -100,7 +97,6 @@ but will have their capitals in bold."
(defcustom glasses-separate-parentheses-p t
"If non-nil, ensure space between an identifier and an opening parenthesis."
- :group 'glasses
:type 'boolean)
(defcustom glasses-separate-parentheses-exceptions
@@ -108,7 +104,6 @@ but will have their capitals in bold."
"List of regexp that are exceptions for `glasses-separate-parentheses-p'.
They are matched to the current line truncated to the point where the
parenthesis expression starts."
- :group 'glasses
:type '(repeat regexp))
(defcustom glasses-separate-capital-groups t
@@ -116,7 +111,6 @@ parenthesis expression starts."
When the value is non-nil, HTMLSomething and IPv6 are displayed
as HTML_Something and I_Pv6 respectively. Set the value to nil
if you prefer to display them unchanged."
- :group 'glasses
:type 'boolean
:version "24.1")
@@ -124,7 +118,6 @@ if you prefer to display them unchanged."
"If non-nil, downcase embedded capital letters in identifiers.
Only identifiers starting with lower case letters are affected, letters inside
other identifiers are unchanged."
- :group 'glasses
:type 'boolean
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -135,7 +128,6 @@ other identifiers are unchanged."
Only words starting with this regexp are uncapitalized.
The regexp is case sensitive.
It has any effect only when `glasses-uncapitalize-p' is non-nil."
- :group 'glasses
:type 'regexp
:set 'glasses-custom-set
:initialize 'custom-initialize-default)
@@ -149,7 +141,6 @@ file write then.
Note the removal action does not try to be much clever, so it can remove real
separators too."
- :group 'glasses
:type 'boolean)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 1f4cbe9..88f73e4 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,6 +1,11 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t;
-*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
+;; Version: 0.3.0
+;; Package-Requires: ((emacs "26.3"))
+
+;; This is a GNU ELPA :core package. Avoid using functionality that
+;; not compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -19,6 +24,11 @@
;;; Commentary:
+;; NOTE: The project API is still experimental and can change in major,
+;; backward-incompatible ways. Everyone is encouraged to try it, and
+;; report to us any problems or use cases we hadn't anticipated, by
+;; sending an email to emacs-devel, or `M-x report-emacs-bug'.
+;;
;; This file contains generic infrastructure for dealing with
;; projects, some utility functions, and commands using that
;; infrastructure.
@@ -27,15 +37,10 @@
;; current project, without having to know which package handles
;; detection of that project type, parsing its config files, etc.
;;
-;; NOTE: The project API is still experimental and can change in major,
-;; backward-incompatible ways. Everyone is encouraged to try it, and
-;; report to us any problems or use cases we hadn't anticipated, by
-;; sending an email to emacs-devel, or `M-x report-emacs-bug'.
-;;
;; Infrastructure:
;;
;; Function `project-current', to determine the current project
-;; instance, and 5 (at the moment) generic functions that act on it.
+;; instance, and 4 (at the moment) generic functions that act on it.
;; This list is to be extended in future versions.
;;
;; Utils:
@@ -117,14 +122,25 @@ is not a part of a detectable project either, return a
(defun project--find-in-directory (dir)
(run-hook-with-args-until-success 'project-find-functions dir))
-(cl-defgeneric project-roots (project)
- "Return the list of directory roots of the current project.
+(cl-defgeneric project-root (project)
+ "Return root directory of the current project.
-Most often it's just one directory which contains the project
-build file and everything else in the project. But in more
-advanced configurations, a project can span multiple directories.
+It usually contains the main build file, dependencies
+configuration file, etc. Though neither is mandatory.
-The directory names should be absolute.")
+The directory name must be absolute."
+ (car (project-roots project)))
+
+(cl-defgeneric project-roots (project)
+ "Return the list containing the current project root.
+
+The function is obsolete, all projects have one main root anyway,
+and the rest should be possible to express through
+`project-external-roots'."
+ ;; FIXME: Can we specify project's version here?
+ ;; FIXME: Could we make this affect cl-defmethod calls too?
+ (declare (obsolete project-root "0.3.0"))
+ (list (project-root project)))
;; FIXME: Add MODE argument, like in `ede-source-paths'?
(cl-defgeneric project-external-roots (_project)
@@ -133,18 +149,14 @@ The directory names should be absolute.")
It's the list of directories outside of the project that are
still related to it. If the project deals with source code then,
depending on the languages used, this list should include the
-headers search path, load path, class path, and so on.
-
-The rule of thumb for whether to include a directory here, and
-not in `project-roots', is whether its contents are meant to be
-edited together with the rest of the project."
+headers search path, load path, class path, and so on."
nil)
(cl-defgeneric project-ignores (_project _dir)
"Return the list of glob patterns to ignore inside DIR.
Patterns can match both regular files and directories.
To root an entry, start it with `./'. To match directories only,
-end it with `/'. DIR must be one of `project-roots' or
+end it with `/'. DIR must be either `project-root' or one of
`project-external-roots'."
;; TODO: Document and support regexp ignores as used by Hg.
;; TODO: Support whitelist entries.
@@ -165,13 +177,13 @@ end it with `/'. DIR must be one of `project-roots' or
(t
(complete-with-action action all-files string pred)))))
-(cl-defmethod project-roots ((project (head transient)))
- (list (cdr project)))
+(cl-defmethod project-root ((project (head transient)))
+ (cdr project))
(cl-defgeneric project-files (project &optional dirs)
"Return a list of files in directories DIRS in PROJECT.
DIRS is a list of absolute directories; it should be some
-subset of the project roots and external roots.
+subset of the project root and external roots.
The default implementation uses `find-program'. PROJECT is used
to find the list of ignores for each directory."
@@ -179,29 +191,32 @@ to find the list of ignores for each directory."
(lambda (dir)
(project--files-in-directory dir
(project--dir-ignores project dir)))
- (or dirs (project-roots project))))
+ (or dirs
+ (list (project-root project)))))
(defun project--files-in-directory (dir ignores &optional files)
(require 'find-dired)
(require 'xref)
(defvar find-name-arg)
- (let ((default-directory dir)
- (command (format "%s %s %s -type f %s -print0"
- find-program
- (file-local-name dir)
- (xref--find-ignores-arguments
- ignores
- (expand-file-name dir))
- (if files
- (concat (shell-quote-argument "(")
- " " find-name-arg " "
- (mapconcat
- #'shell-quote-argument
- (split-string files)
- (concat " -o " find-name-arg " "))
- " "
- (shell-quote-argument ")"))"")
- )))
+ (let* ((default-directory dir)
+ ;; Make sure ~/ etc. in local directory name is
+ ;; expanded and not left for the shell command
+ ;; to interpret.
+ (localdir (file-local-name (expand-file-name dir)))
+ (command (format "%s %s %s -type f %s -print0"
+ find-program
+ localdir
+ (xref--find-ignores-arguments ignores localdir)
+ (if files
+ (concat (shell-quote-argument "(")
+ " " find-name-arg " "
+ (mapconcat
+ #'shell-quote-argument
+ (split-string files)
+ (concat " -o " find-name-arg " "))
+ " "
+ (shell-quote-argument ")"))"")
+ )))
(project--remote-file-names
(sort (split-string (shell-command-to-string command) "\0" t)
#'string<))))
@@ -216,7 +231,7 @@ to find the list of ignores for each directory."
local-files))))
(defgroup project-vc nil
- "Project implementation using the VC package."
+ "Project implementation based on the VC package."
:version "25.1"
:group 'tools)
@@ -225,6 +240,15 @@ to find the list of ignores for each directory."
:type '(repeat string)
:safe 'listp)
+(defcustom project-vc-merge-submodules t
+ "Non-nil to consider submodules part of the parent project.
+
+After changing this variable (using Customize or .dir-locals.el)
+you might have to restart Emacs to see the effect."
+ :type 'boolean
+ :package-version '(project . "0.2.0")
+ :safe 'booleanp)
+
;; FIXME: Using the current approach, major modes are supposed to set
;; this variable to a buffer-local value. So we don't have access to
;; the "external roots" of language A from buffers of language B, which
@@ -267,14 +291,47 @@ backend implementation of `project-external-roots'.")
('Git
;; Don't stop at submodule boundary.
(or (vc-file-getprop dir 'project-git-root)
- (vc-file-setprop dir 'project-git-root
- (vc-find-root dir ".git/"))))
+ (let ((root (vc-call-backend backend 'root dir)))
+ (vc-file-setprop
+ dir 'project-git-root
+ (if (and
+ ;; FIXME: Invalidate the cache when the value
+ ;; of this variable changes.
+ project-vc-merge-submodules
+ (project--submodule-p root))
+ (let* ((parent (file-name-directory
+ (directory-file-name root))))
+ (vc-call-backend backend 'root parent))
+ root)))))
('nil nil)
(_ (ignore-errors (vc-call-backend backend 'root dir))))))
(and root (cons 'vc root))))
-(cl-defmethod project-roots ((project (head vc)))
- (list (cdr project)))
+(defun project--submodule-p (root)
+ ;; XXX: We only support Git submodules for now.
+ ;;
+ ;; For submodules, at least, we expect the users to prefer them to
+ ;; be considered part of the parent project. For those who don't,
+ ;; there is the custom var now.
+ ;;
+ ;; Some users may also set up things equivalent to Git submodules
+ ;; using "git worktree" (for example). However, we expect that most
+ ;; of them would prefer to treat those as separate projects anyway.
+ (let* ((gitfile (expand-file-name ".git" root)))
+ (cond
+ ((file-directory-p gitfile)
+ nil)
+ ((with-temp-buffer
+ (insert-file-contents gitfile)
+ (goto-char (point-min))
+ ;; Kind of a hack to distinguish a submodule from
+ ;; other cases of .git files pointing elsewhere.
+ (looking-at "gitdir: [./]+/\\.git/modules/"))
+ t)
+ (t nil))))
+
+(cl-defmethod project-root ((project (head vc)))
+ (cdr project))
(cl-defmethod project-external-roots ((project (head vc)))
(project-subtract-directories
@@ -282,7 +339,7 @@ backend implementation of `project-external-roots'.")
(mapcar
#'file-name-as-directory
(funcall project-vc-external-roots-function)))
- (project-roots project)))
+ (list (project-root project))))
(cl-defmethod project-files ((project (head vc)) &optional dirs)
(cl-mapcan
@@ -300,7 +357,8 @@ backend implementation of `project-external-roots'.")
(project--files-in-directory
dir
(project--dir-ignores project dir)))))
- (or dirs (project-roots project))))
+ (or dirs
+ (list (project-root project)))))
(declare-function vc-git--program-version "vc-git")
(declare-function vc-git--run-command-string "vc-git")
@@ -342,7 +400,9 @@ backend implementation of `project-external-roots'.")
submodules)))
(setq files
(apply #'nconc files sub-files)))
- files))
+ ;; 'git ls-files' returns duplicate entries for merge conflicts.
+ ;; XXX: Better solutions welcome, but this seems cheap enough.
+ (delete-consecutive-dups files)))
(`Hg
(let ((default-directory (expand-file-name (file-name-as-directory dir)))
args)
@@ -441,7 +501,7 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
(let* ((pr (project-current t))
(files
(if (not current-prefix-arg)
- (project-files pr (project-roots pr))
+ (project-files pr)
(let ((dir (read-directory-name "Base directory: "
nil default-directory t)))
(project--files-in-directory dir
@@ -452,9 +512,8 @@ requires quoting, e.g. `\\[quoted-insert]<space>'."
nil)))
(defun project--dir-ignores (project dir)
- (let* ((roots (project-roots project))
- (root (cl-find dir roots :test #'file-in-directory-p)))
- (if (not root)
+ (let ((root (project-root project)))
+ (if (not (file-in-directory-p dir root))
(project-ignores nil nil) ;The defaults.
(let ((ignores (project-ignores project root)))
(if (file-equal-p root dir)
@@ -472,8 +531,8 @@ pattern to search for."
(require 'xref)
(let* ((pr (project-current t))
(files
- (project-files pr (append
- (project-roots pr)
+ (project-files pr (cons
+ (project-root pr)
(project-external-roots pr)))))
(xref--show-xrefs
(apply-partially #'project--find-regexp-in-files regexp files)
@@ -511,23 +570,23 @@ pattern to search for."
;;;###autoload
(defun project-find-file ()
- "Visit a file (with completion) in the current project's roots.
+ "Visit a file (with completion) in the current project.
The completion default is the filename at point, if one is
recognized."
(interactive)
(let* ((pr (project-current t))
- (dirs (project-roots pr)))
+ (dirs (list (project-root pr))))
(project-find-file-in (thing-at-point 'filename) dirs pr)))
;;;###autoload
(defun project-or-external-find-file ()
- "Visit a file (with completion) in the current project's roots or external
roots.
+ "Visit a file (with completion) in the current project or external roots.
The completion default is the filename at point, if one is
recognized."
(interactive)
(let* ((pr (project-current t))
- (dirs (append
- (project-roots pr)
+ (dirs (cons
+ (project-root pr)
(project-external-roots pr))))
(project-find-file-in (thing-at-point 'filename) dirs pr)))
@@ -630,5 +689,13 @@ loop using the command \\[fileloop-continue]."
from to (project-files (project-current t)) 'default)
(fileloop-continue))
+;;;###autoload
+(defun project-compile ()
+ "Run `compile' in the project root."
+ (interactive)
+ (let* ((pr (project-current t))
+ (default-directory (project-root pr)))
+ (call-interactively 'compile)))
+
(provide 'project)
;;; project.el ends here
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 67383b3..1ca9f01 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -261,7 +261,6 @@
(require 'ansi-color)
(require 'cl-lib)
(require 'comint)
-(require 'json)
(require 'tramp-sh)
;; Avoid compiler warnings
@@ -2276,6 +2275,18 @@ Do not set this variable directly, instead use
Do not set this variable directly, instead use
`python-shell-prompt-set-calculated-regexps'.")
+(defalias 'python--parse-json-array
+ (if (fboundp 'json-parse-string)
+ (lambda (string)
+ (json-parse-string string :array-type 'list))
+ (require 'json)
+ (defvar json-array-type)
+ (declare-function json-read-from-string "json" (string))
+ (lambda (string)
+ (let ((json-array-type 'list))
+ (json-read-from-string string))))
+ "Parse the JSON array in STRING into a Lisp list.")
+
(defun python-shell-prompt-detect ()
"Detect prompts for the current `python-shell-interpreter'.
When prompts can be retrieved successfully from the
@@ -2324,11 +2335,11 @@ detection and just returns nil."
(catch 'prompts
(dolist (line (split-string output "\n" t))
(let ((res
- ;; Check if current line is a valid JSON array
- (and (string= (substring line 0 2) "[\"")
+ ;; Check if current line is a valid JSON array.
+ (and (string-prefix-p "[\"" line)
(ignore-errors
- ;; Return prompts as a list, not vector
- (append (json-read-from-string line) nil)))))
+ ;; Return prompts as a list.
+ (python--parse-json-array line)))))
;; The list must contain 3 strings, where the first
;; is the input prompt, the second is the block
;; prompt and the last one is the output prompt. The
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index 22c6158..9cd84cf 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -14730,7 +14730,7 @@ if required."
(speedbar-add-mode-functions-list
'("vhdl directory"
(speedbar-item-info . vhdl-speedbar-item-info)
- (speedbar-line-directory . speedbar-files-line-path)))
+ (speedbar-line-directory . speedbar-files-line-directory)))
(speedbar-add-mode-functions-list
'("vhdl project"
(speedbar-item-info . vhdl-speedbar-item-info)
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 1cee552..266f40a 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -186,7 +186,7 @@ and you want to simplify them for the mode line
"Non-nil means display current function name in mode line.
This makes a difference only if `which-function-mode' is non-nil.")
-(add-hook 'find-file-hook 'which-func-ff-hook t)
+(add-hook 'after-change-major-mode-hook 'which-func-ff-hook t)
(defun which-func-try-to-enable ()
(unless (or (not which-function-mode)
@@ -195,7 +195,7 @@ This makes a difference only if `which-function-mode' is
non-nil.")
(member major-mode which-func-modes)))))
(defun which-func-ff-hook ()
- "File find hook for Which Function mode.
+ "`after-change-major-mode-hook' for Which Function mode.
It creates the Imenu index for the buffer, if necessary."
(which-func-try-to-enable)
@@ -282,52 +282,55 @@ If no function name is found, return nil."
(when (null name)
(setq name (add-log-current-defun)))
;; If Imenu is loaded, try to make an index alist with it.
+ ;; If `add-log-current-defun' ran and gave nil, accept that.
(when (and (null name)
- (boundp 'imenu--index-alist)
- (or (null imenu--index-alist)
- ;; Update if outdated
- (/= (buffer-chars-modified-tick)
imenu-menubar-modified-tick))
- (null which-function-imenu-failed))
- (ignore-errors (imenu--make-index-alist t))
- (unless imenu--index-alist
- (set (make-local-variable 'which-function-imenu-failed) t)))
- ;; If we have an index alist, use it.
- (when (and (null name)
- (boundp 'imenu--index-alist) imenu--index-alist)
- (let ((alist imenu--index-alist)
- (minoffset (point-max))
- offset pair mark imstack namestack)
- ;; Elements of alist are either ("name" . marker), or
- ;; ("submenu" ("name" . marker) ... ). The list can be
- ;; arbitrarily nested.
- (while (or alist imstack)
- (if (null alist)
- (setq alist (car imstack)
- namestack (cdr namestack)
- imstack (cdr imstack))
-
- (setq pair (car-safe alist)
- alist (cdr-safe alist))
-
- (cond
- ((atom pair)) ; Skip anything not a cons.
-
- ((imenu--subalist-p pair)
- (setq imstack (cons alist imstack)
- namestack (cons (car pair) namestack)
- alist (cdr pair)))
-
- ((or (number-or-marker-p (setq mark (cdr pair)))
- (and (overlayp mark)
- (setq mark (overlay-start mark))))
- (when (and (>= (setq offset (- (point) mark)) 0)
- (< offset minoffset)) ; Find the closest item.
- (setq minoffset offset
- name (if (null which-func-imenu-joiner-function)
- (car pair)
- (funcall
- which-func-imenu-joiner-function
- (reverse (cons (car pair) namestack))))))))))))
+ (null add-log-current-defun-function))
+ (when (and (null name)
+ (boundp 'imenu--index-alist)
+ (or (null imenu--index-alist)
+ ;; Update if outdated
+ (/= (buffer-chars-modified-tick)
imenu-menubar-modified-tick))
+ (null which-function-imenu-failed))
+ (ignore-errors (imenu--make-index-alist t))
+ (unless imenu--index-alist
+ (set (make-local-variable 'which-function-imenu-failed) t)))
+ ;; If we have an index alist, use it.
+ (when (and (null name)
+ (boundp 'imenu--index-alist) imenu--index-alist)
+ (let ((alist imenu--index-alist)
+ (minoffset (point-max))
+ offset pair mark imstack namestack)
+ ;; Elements of alist are either ("name" . marker), or
+ ;; ("submenu" ("name" . marker) ... ). The list can be
+ ;; arbitrarily nested.
+ (while (or alist imstack)
+ (if (null alist)
+ (setq alist (car imstack)
+ namestack (cdr namestack)
+ imstack (cdr imstack))
+
+ (setq pair (car-safe alist)
+ alist (cdr-safe alist))
+
+ (cond
+ ((atom pair)) ; Skip anything not a cons.
+
+ ((imenu--subalist-p pair)
+ (setq imstack (cons alist imstack)
+ namestack (cons (car pair) namestack)
+ alist (cdr pair)))
+
+ ((or (number-or-marker-p (setq mark (cdr pair)))
+ (and (overlayp mark)
+ (setq mark (overlay-start mark))))
+ (when (and (>= (setq offset (- (point) mark)) 0)
+ (< offset minoffset)) ; Find the closest item.
+ (setq minoffset offset
+ name (if (null which-func-imenu-joiner-function)
+ (car pair)
+ (funcall
+ which-func-imenu-joiner-function
+ (reverse (cons (car pair)
namestack)))))))))))))
;; Filter the name if requested.
(when name
(if which-func-cleanup-function
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index c36a9bd..2477884 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -1,6 +1,11 @@
-;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
+;;; xref.el --- Cross-referencing commands -*-lexical-binding:t-*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
+;; Version: 1.0.1
+;; Package-Requires: ((emacs "26.3") (project "0.1.1"))
+
+;; This is a GNU ELPA :core package. Avoid functionality that is not
+;; compatible with the version of Emacs recorded above.
;; This file is part of GNU Emacs.
@@ -263,8 +268,8 @@ find a search tool; by default, this uses \"find | grep\"
in the
(lambda (dir)
(xref-references-in-directory identifier dir))
(let ((pr (project-current t)))
- (append
- (project-roots pr)
+ (cons
+ (project-root pr)
(project-external-roots pr)))))
(cl-defgeneric xref-backend-apropos (backend pattern)
@@ -1317,11 +1322,11 @@ directory, used as the root of the ignore globs."
(lambda (ignore)
(when (string-match-p "/\\'" ignore)
(setq ignore (concat ignore "*")))
- (if (string-match "\\`\\./" ignore)
- (setq ignore (replace-match dir t t ignore))
- (unless (string-prefix-p "*" ignore)
- (setq ignore (concat "*/" ignore))))
- (shell-quote-argument ignore))
+ (shell-quote-argument (if (string-match "\\`\\./" ignore)
+ (replace-match dir t t ignore)
+ (if (string-prefix-p "*" ignore)
+ ignore
+ (concat "*/" ignore)))))
ignores
" -o -path ")
" "
diff --git a/lisp/replace.el b/lisp/replace.el
index 168ccf2..f3a71f8 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -340,13 +340,17 @@ that reads FROM-STRING, or invoke replacements from
incremental search with a key sequence like `C-s C-s M-%'
to use its current search string as the string to replace.
-Matching is independent of case if `case-fold-search' is non-nil and
-FROM-STRING has no uppercase letters. Replacement transfers the case
-pattern of the old text to the new text, if `case-replace' and
-`case-fold-search' are non-nil and FROM-STRING has no uppercase
-letters. (Transferring the case pattern means that if the old text
-matched is all caps, or capitalized, then its replacement is upcased
-or capitalized.)
+Matching is independent of case if both `case-fold-search'
+and `search-upper-case' are non-nil and FROM-STRING has no
+uppercase letters; if `search-upper-case' is nil, then
+whether matching ignores case depends on `case-fold-search'
+regardless of whether there are uppercase letters in FROM-STRING.
+Replacement transfers the case pattern of the old text to the
+new text, if both `case-fold-search' and `case-replace' are
+non-nil and FROM-STRING has no uppercase letters.
+\(Transferring the case pattern means that if the old text
+matched is all caps, or capitalized, then its replacement is
+respectively upcased or capitalized.)
Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
ignore hidden matches if `search-invisible' is nil, and ignore more
@@ -402,13 +406,16 @@ that reads REGEXP, or invoke replacements from
incremental search with a key sequence like `C-M-s C-M-s C-M-%'
to use its current search regexp as the regexp to replace.
-Matching is independent of case if `case-fold-search' is non-nil and
-REGEXP has no uppercase letters. Replacement transfers the case
-pattern of the old text to the new text, if `case-replace' and
-`case-fold-search' are non-nil and REGEXP has no uppercase letters.
-\(Transferring the case pattern means that if the old text matched is
-all caps, or capitalized, then its replacement is upcased or
-capitalized.)
+Matching is independent of case if both `case-fold-search'
+and `search-upper-case' are non-nil and REGEXP has no uppercase
+letters; if `search-upper-case' is nil, then whether matching
+ignores case depends on `case-fold-search' regardless of whether
+there are uppercase letters in REGEXP.
+Replacement transfers the case pattern of the old text to the new
+text, if both `case-fold-search' and `case-replace' are non-nil
+and REGEXP has no uppercase letters. (Transferring the case pattern
+means that if the old text matched is all caps, or capitalized,
+then its replacement is respectively upcased or capitalized.)
Ignore read-only matches if `query-replace-skip-read-only' is non-nil,
ignore hidden matches if `search-invisible' is nil, and ignore more
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
index fa0e181..46738ab 100644
--- a/lisp/saveplace.el
+++ b/lisp/saveplace.el
@@ -248,8 +248,8 @@ may have changed) back to `save-place-alist'."
(delete-region (point-min) (point-max))
(when save-place-forget-unreadable-files
(save-place-forget-unreadable-files))
- (insert (format ";;; -*- coding: %s -*-\n"
- (symbol-name coding-system-for-write)))
+ (insert (format ";;; -*- coding: %s; mode: lisp-data -*-\n"
+ coding-system-for-write))
(let ((print-length nil)
(print-level nil))
(pp save-place-alist (current-buffer)))
diff --git a/lisp/simple.el b/lisp/simple.el
index b5ba054..111afa6 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -4141,6 +4141,20 @@ its behavior with respect to remote file attribute
caching.
You should only ever change this variable with a let-binding;
never with `setq'.")
+(defcustom process-file-return-signal-string nil
+ "Whether to return a string describing the signal interrupting a process.
+When a process returns an exit code greater than 128, it is
+interpreted as a signal. `process-file' requires to return a
+string describing this signal.
+Since there are processes violating this rule, returning exit
+codes greater than 128 which are not bound to a signal,
+`process-file' returns the exit code as natural number also in
+this case. Setting this user option to non-nil forces
+`process-file' to interpret such exit codes as signals, and to
+return a corresponding string."
+ :version "28.1"
+ :type 'boolean)
+
(defun start-file-process (name buffer program &rest program-args)
"Start a program in a subprocess. Return the process object for it.
@@ -4889,7 +4903,7 @@ of this sample text; it defaults to 40."
;; Swap point-and-mark quickly so as to show the region that
;; was selected. Don't do it if the region is highlighted.
(unless (and (region-active-p)
- (face-background 'region))
+ (face-background 'region nil t))
;; Swap point and mark.
(set-marker (mark-marker) (point) (current-buffer))
(goto-char mark)
diff --git a/lisp/subr.el b/lisp/subr.el
index c891314..10c37e9 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -257,10 +257,9 @@ Then evaluate RESULT to get return value, default nil.
;; use dolist.
;; FIXME: This cost disappears in byte-compiled lexical-binding files.
(let ((temp '--dolist-tail--))
- ;; This is not a reliable test, but it does not matter because both
- ;; semantics are acceptable, tho one is slightly faster with dynamic
- ;; scoping and the other is slightly faster (and has cleaner semantics)
- ;; with lexical scoping.
+ ;; This test does not matter much because both semantics are acceptable,
+ ;; but one is slightly faster with dynamic scoping and the other is
+ ;; slightly faster (and has cleaner semantics) with lexical scoping.
(if lexical-binding
`(let ((,temp ,(nth 1 spec)))
(while ,temp
@@ -292,9 +291,9 @@ the return value (nil if RESULT is omitted). Its use is
deprecated.
(let ((temp '--dotimes-limit--)
(start 0)
(end (nth 1 spec)))
- ;; This is not a reliable test, but it does not matter because both
- ;; semantics are acceptable, tho one is slightly faster with dynamic
- ;; scoping and the other has cleaner semantics.
+ ;; This test does not matter much because both semantics are acceptable,
+ ;; but one is slightly faster with dynamic scoping and the other has
+ ;; cleaner semantics.
(if lexical-binding
(let ((counter '--dotimes-counter--))
`(let ((,temp ,end)
@@ -4033,7 +4032,7 @@ the function `undo--wrap-and-run-primitive-undo'."
(defmacro combine-change-calls (beg end &rest body)
"Evaluate BODY, running the change hooks just once.
-BODY is a sequence of lisp forms to evaluate. BEG and END bound
+BODY is a sequence of Lisp forms to evaluate. BEG and END bound
the region the change hooks will be run for.
Firstly, `before-change-functions' is invoked for the region
@@ -4051,7 +4050,8 @@ change `before-change-functions' or
`after-change-functions'.
Additionally, the buffer modifications of BODY are recorded on
the buffer's undo list as a single \(apply ...) entry containing
-the function `undo--wrap-and-run-primitive-undo'. "
+the function `undo--wrap-and-run-primitive-undo'."
+ (declare (debug t) (indent 2))
`(combine-change-calls-1 ,beg ,end (lambda () ,@body)))
(defun undo--wrap-and-run-primitive-undo (beg end list)
@@ -4112,7 +4112,11 @@ MODES is as for `set-default-file-modes'."
;; now, but it generates slower code.
(defmacro save-match-data (&rest body)
"Execute the BODY forms, restoring the global value of the match data.
-The value returned is the value of the last form in BODY."
+The value returned is the value of the last form in BODY.
+NOTE: The convention in Elisp is that any function, except for a few
+exceptions like car/assoc/+/goto-char, can clobber the match data,
+so `save-match-data' should normally be used to save *your* match data
+rather than your caller's match data."
;; It is better not to use backquote here,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
diff --git a/lisp/t-mouse.el b/lisp/t-mouse.el
index fc17417..a1af53d 100644
--- a/lisp/t-mouse.el
+++ b/lisp/t-mouse.el
@@ -1,4 +1,4 @@
-;;; t-mouse.el --- mouse support within the text terminal
+;;; t-mouse.el --- mouse support within the text terminal -*-
lexical-binding:t -*-
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: emacs-devel@gnu.org
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index 30ed1a4..ce6d8c3 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -87,10 +87,11 @@
(defcustom tab-bar-select-tab-modifiers '()
- "List of key modifiers for selecting a tab by its index digit.
-Possible modifiers are `control', `meta', `shift', `hyper', `super' and
-`alt'."
- :type '(set :tag "Tab selection key modifiers"
+ "List of modifier keys for selecting a tab by its index digit.
+Possible modifier keys are `control', `meta', `shift', `hyper', `super' and
+`alt'. To help you to select a tab by its number, you can customize
+`tab-bar-tab-hints' that will show tab numbers alongside the tab name."
+ :type '(set :tag "Tab selection modifier keys"
(const control)
(const meta)
(const shift)
@@ -310,7 +311,8 @@ If nil, don't show it at all."
(defcustom tab-bar-tab-hints nil
"Show absolute numbers on tabs in the tab bar before the tab name.
-This helps to select the tab by its number using `tab-bar-select-tab'."
+This helps to select the tab by its number using `tab-bar-select-tab'
+and `tab-bar-select-tab-modifiers'."
:type 'boolean
:initialize 'custom-initialize-default
:set (lambda (sym val)
@@ -563,9 +565,10 @@ Return its existing value or a new value."
(defun tab-bar-select-tab (&optional arg)
"Switch to the tab by its absolute position ARG in the tab bar.
-When this command is bound to a numeric key (with a prefix or modifier),
-calling it without an argument will translate its bound numeric key
-to the numeric argument. ARG counts from 1."
+When this command is bound to a numeric key (with a prefix or modifier key
+using `tab-bar-select-tab-modifiers'), calling it without an argument
+will translate its bound numeric key to the numeric argument.
+ARG counts from 1."
(interactive "P")
(unless (integerp arg)
(let ((key (event-basic-type last-command-event)))
@@ -664,7 +667,10 @@ to the numeric argument. ARG counts from 1."
(message "No more recent tabs"))))
(defun tab-bar-switch-to-tab (name)
- "Switch to the tab by NAME."
+ "Switch to the tab by NAME.
+Default values are tab names sorted by recency, so you can use \
+\\<minibuffer-local-map>\\[next-history-element]
+to get the name of the last visited tab, the second last, and so on."
(interactive
(let* ((recent-tabs (mapcar (lambda (tab)
(alist-get 'name tab))
@@ -789,7 +795,7 @@ After the tab is created, the hooks in
(pcase tab-bar-new-tab-to
('leftmost 0)
('rightmost (length tabs))
- ('left (1- (or from-index 1)))
+ ('left (or from-index 1))
('right (1+ (or from-index 0)))
((pred functionp)
(funcall tab-bar-new-tab-to))))))
@@ -920,7 +926,7 @@ for the last tab on a frame is determined by
;; Select another tab before deleting the current tab
(let ((to-index (or (if to-index (1- to-index))
(pcase tab-bar-close-tab-select
- ('left (1- current-index))
+ ('left (1- (if (< current-index 1) 2
current-index)))
('right (if (> (length tabs) (1+
current-index))
(1+ current-index)
(1- current-index)))
@@ -1004,7 +1010,7 @@ for the last tab on a frame is determined by
(unless (eq frame (selected-frame))
(select-frame-set-input-focus frame))
- (let ((tabs (tab-bar-tabs)))
+ (let ((tabs (funcall tab-bar-tabs-function)))
(setq index (max 0 (min index (length tabs))))
(cl-pushnew tab (nthcdr index tabs))
(when (eq index 0)
@@ -1102,6 +1108,8 @@ function `tab-bar-tab-name-function'."
(setq tab-bar-history-omit nil)))
(defun tab-bar-history-back ()
+ "Restore a previous window configuration used in the current tab.
+This navigates back in the history of window configurations."
(interactive)
(setq tab-bar-history-omit t)
(let* ((history (pop (gethash (selected-frame) tab-bar-history-back)))
@@ -1119,6 +1127,8 @@ function `tab-bar-tab-name-function'."
(message "No more tab back history"))))
(defun tab-bar-history-forward ()
+ "Cancel restoration of the previous window configuration.
+This navigates forward in the history of window configurations."
(interactive)
(setq tab-bar-history-omit t)
(let* ((history (pop (gethash (selected-frame) tab-bar-history-forward)))
@@ -1136,7 +1146,9 @@ function `tab-bar-tab-name-function'."
(message "No more tab forward history"))))
(define-minor-mode tab-bar-history-mode
- "Toggle tab history mode for the tab bar."
+ "Toggle tab history mode for the tab bar.
+Tab history mode remembers window configurations used in every tab,
+and can restore them."
:global t :group 'tab-bar
(if tab-bar-history-mode
(progn
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index eb279de..7a2bdc0 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -474,8 +474,12 @@ variable `tab-line-tabs-function'."
"Template for displaying tab line for selected window."
(let* ((tabs (funcall tab-line-tabs-function))
(cache-key (list tabs
+ ;; handle buffer renames
(buffer-name (window-buffer))
- (window-parameter nil 'tab-line-hscroll)))
+ ;; handle tab-line scrolling
+ (window-parameter nil 'tab-line-hscroll)
+ ;; for setting face 'tab-line-tab-current'
+ (eq (selected-window) (old-selected-window))))
(cache (window-parameter nil 'tab-line-cache)))
;; Enable auto-hscroll again after it was disabled on manual scrolling.
;; The moment to enable it is when the window-buffer was updated.
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index a3c1715..73978ff 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -480,23 +480,9 @@ checksum before doing the check."
(defun tar-grind-file-mode (mode)
"Construct a `rw-r--r--' string indicating MODE.
-MODE should be an integer which is a file mode value."
- (string
- (if (zerop (logand 256 mode)) ?- ?r)
- (if (zerop (logand 128 mode)) ?- ?w)
- (if (zerop (logand 2048 mode))
- (if (zerop (logand 64 mode)) ?- ?x)
- (if (zerop (logand 64 mode)) ?S ?s))
- (if (zerop (logand 32 mode)) ?- ?r)
- (if (zerop (logand 16 mode)) ?- ?w)
- (if (zerop (logand 1024 mode))
- (if (zerop (logand 8 mode)) ?- ?x)
- (if (zerop (logand 8 mode)) ?S ?s))
- (if (zerop (logand 4 mode)) ?- ?r)
- (if (zerop (logand 2 mode)) ?- ?w)
- (if (zerop (logand 512 mode))
- (if (zerop (logand 1 mode)) ?- ?x)
- (if (zerop (logand 1 mode)) ?T ?t))))
+MODE should be an integer which is a file mode value.
+For instance, if mode is #o700, then it produces `rwx------'."
+ (substring (file-modes-number-to-symbolic mode) 1))
(defun tar-header-block-summarize (tar-hblock &optional mod-p)
"Return a line similar to the output of `tar -vtf'."
diff --git a/lisp/term/bobcat.el b/lisp/term/bobcat.el
index a32da6a..983c8cd 100644
--- a/lisp/term/bobcat.el
+++ b/lisp/term/bobcat.el
@@ -1,3 +1,4 @@
+;;; bobcat.el -*- lexical-binding:t -*-
(defun terminal-init-bobcat ()
"Terminal initialization function for bobcat."
diff --git a/lisp/term/cygwin.el b/lisp/term/cygwin.el
index edc64b4..8f0d751 100644
--- a/lisp/term/cygwin.el
+++ b/lisp/term/cygwin.el
@@ -1,4 +1,4 @@
-;;; cygwin.el --- support for the Cygwin terminal
+;;; cygwin.el --- support for the Cygwin terminal -*- lexical-binding:t -*-
;;; The Cygwin terminal can't really display underlines.
diff --git a/lisp/term/konsole.el b/lisp/term/konsole.el
index 8b2e7e1..4af818b 100644
--- a/lisp/term/konsole.el
+++ b/lisp/term/konsole.el
@@ -1,4 +1,4 @@
-;;; konsole.el --- terminal initialization for konsole
+;;; konsole.el --- terminal initialization for konsole -*- lexical-binding:t
-*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
(require 'term/xterm)
diff --git a/lisp/term/linux.el b/lisp/term/linux.el
index 70730dc..35bd3ac 100644
--- a/lisp/term/linux.el
+++ b/lisp/term/linux.el
@@ -1,4 +1,4 @@
-;; The Linux console handles Latin-1 by default.
+;; The Linux console handles Latin-1 by default. -*- lexical-binding:t -*-
(declare-function gpm-mouse-enable "t-mouse" ())
diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el
index 7ddbe38..2df1414 100644
--- a/lisp/term/vt100.el
+++ b/lisp/term/vt100.el
@@ -1,4 +1,4 @@
-;;; vt100.el --- define VT100 function key sequences in function-key-map
+;;; vt100.el --- define VT100 function key sequences in function-key-map -*-
lexical-binding:t -*-
;; Copyright (C) 1989, 1993, 2001-2020 Free Software Foundation, Inc.
diff --git a/lisp/term/vt200.el b/lisp/term/vt200.el
index dde2e22..569b79e 100644
--- a/lisp/term/vt200.el
+++ b/lisp/term/vt200.el
@@ -1,3 +1,5 @@
+;;; vt200.el -*- lexical-binding:t -*-
+
;; For our purposes we can treat the vt200 and vt100 almost alike.
;; Most differences are handled by the termcap entry.
(defun terminal-init-vt200 ()
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index 5b8feb1..42a6f40 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -1407,13 +1407,13 @@ This returns an error if any Emacs frames are X frames."
("etc/images/right-arrow" . ("go-next" "gtk-go-forward"))
("etc/images/home" . ("go-home" "gtk-home"))
("etc/images/jump-to" . ("go-jump" "gtk-jump-to"))
- ("etc/images/index" . "gtk-index")
+ ("etc/images/index" . ("gtk-search" "gtk-index"))
("etc/images/exit" . ("application-exit" "gtk-quit"))
("etc/images/cancel" . "gtk-cancel")
("etc/images/info" . ("dialog-information" "gtk-info"))
("etc/images/bookmark_add" . "n:bookmark_add")
;; Used in Gnus and/or MH-E:
- ("etc/images/attach" . "gtk-attach")
+ ("etc/images/attach" . ("mail-attachment" "gtk-attach"))
("etc/images/connect" . "gtk-connect")
("etc/images/contact" . "gtk-contact")
("etc/images/delete" . ("edit-delete" "gtk-delete"))
@@ -1425,14 +1425,16 @@ This returns an error if any Emacs frames are X frames."
("etc/images/lock" . "gtk-lock")
("etc/images/next-page" . "gtk-next-page")
("etc/images/refresh" . ("view-refresh" "gtk-refresh"))
+ ("etc/images/search-replace" . "edit-find-replace")
("etc/images/sort-ascending" . ("view-sort-ascending"
"gtk-sort-ascending"))
("etc/images/sort-column-ascending" . "gtk-sort-column-ascending")
("etc/images/sort-criteria" . "gtk-sort-criteria")
("etc/images/sort-descending" . ("view-sort-descending"
"gtk-sort-descending"))
("etc/images/sort-row-ascending" . "gtk-sort-row-ascending")
+ ("etc/images/spell" . ("tools-check-spelling" "gtk-spell-check"))
("images/gnus/toggle-subscription" . "gtk-task-recurring")
- ("images/mail/compose" . "gtk-mail-compose")
+ ("images/mail/compose" . ("mail-message-new" "gtk-mail-compose"))
("images/mail/copy" . "gtk-mail-copy")
("images/mail/forward" . "gtk-mail-forward")
("images/mail/inbox" . "gtk-inbox")
@@ -1442,7 +1444,7 @@ This returns an error if any Emacs frames are X frames."
("images/mail/reply-all" . "gtk-mail-reply-to-all")
("images/mail/reply" . "gtk-mail-reply")
("images/mail/save-draft" . "gtk-mail-handling")
- ("images/mail/send" . "gtk-mail-send")
+ ("images/mail/send" . ("mail-send" "gtk-mail-send"))
("images/mail/spam" . "gtk-spam")
;; Used for GDB Graphical Interface
("images/gud/break" . "gtk-no")
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 670e763..4712f31 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -440,7 +440,7 @@ If parsing fails, try to set this variable to nil."
"Alist of BibTeX entry types and their associated fields.
Elements are lists (ENTRY-TYPE DOC REQUIRED CROSSREF OPTIONAL).
ENTRY-TYPE is the type of a BibTeX entry.
-DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used.
+DOC is a brief doc string used for menus. If nil ENTRY-TYPE is used.
REQUIRED is a list of required fields.
CROSSREF is a list of fields that are optional if a crossref field
is present; but these fields are required otherwise.
@@ -1051,7 +1051,7 @@ See `bibtex-generate-autokey' for details."
(defvaralias 'bibtex-autokey-name-case-convert
'bibtex-autokey-name-case-convert-function)
-(defcustom bibtex-autokey-name-case-convert-function 'downcase
+(defcustom bibtex-autokey-name-case-convert-function #'downcase
"Function called for each name to perform case conversion.
See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
@@ -1127,7 +1127,7 @@ Case is significant. See `bibtex-generate-autokey' for
details."
(defvaralias 'bibtex-autokey-titleword-case-convert
'bibtex-autokey-titleword-case-convert-function)
-(defcustom bibtex-autokey-titleword-case-convert-function 'downcase
+(defcustom bibtex-autokey-titleword-case-convert-function #'downcase
"Function called for each titleword to perform case conversion.
See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
@@ -1188,12 +1188,13 @@ See `bibtex-generate-autokey' for details."
:group 'bibtex-autokey
:type 'boolean)
-(defcustom bibtex-autokey-before-presentation-function nil
- "If non-nil, function to call before generated key is presented.
+(defcustom bibtex-autokey-before-presentation-function #'identity
+ "Function to call before generated key is presented.
The function must take one argument (the automatically generated key),
and must return a string (the key to use)."
:group 'bibtex-autokey
- :type '(choice (const nil) function))
+ :version "28.1"
+ :type 'function)
(defcustom bibtex-entry-offset 0
"Offset for BibTeX entries.
@@ -1242,7 +1243,7 @@ If non-nil, the column for the equal sign is the value of
:group 'bibtex
:type '(repeat string))
-(defcustom bibtex-summary-function 'bibtex-summary
+(defcustom bibtex-summary-function #'bibtex-summary
"Function to call for generating a summary of current BibTeX entry.
It takes no arguments. Point must be at beginning of entry.
Used by `bibtex-complete-crossref-cleanup' and `bibtex-copy-summary-as-kill'."
@@ -1660,7 +1661,7 @@ Initialized by `bibtex-set-dialect'.")
(defvar bibtex-font-lock-url-regexp
;; Assume that field names begin at the beginning of a line.
(concat "^[ \t]*"
- (regexp-opt (delete-dups (mapcar 'caar bibtex-generate-url-list)) t)
+ (regexp-opt (delete-dups (mapcar #'caar bibtex-generate-url-list)) t)
"[ \t]*=[ \t]*")
"Regexp for `bibtex-font-lock-url' derived from `bibtex-generate-url-list'.")
@@ -1892,14 +1893,16 @@ If `bibtex-expand-strings' is non-nil, also expand
BibTeX strings."
(let ((mtch (match-string-no-properties 0)))
(push (or (if bibtex-expand-strings
(cdr (assoc-string mtch (bibtex-strings) t)))
- mtch) content)
+ mtch)
+ content)
(goto-char (match-end 0)))
(let ((bounds (bibtex-parse-field-string)))
(push (buffer-substring-no-properties
- (1+ (car bounds)) (1- (cdr bounds))) content)
+ (1+ (car bounds)) (1- (cdr bounds)))
+ content)
(goto-char (cdr bounds))))
(re-search-forward "\\=[ \t\n]*#[ \t\n]*" nil t))
- (apply 'concat (nreverse content))))
+ (apply #'concat (nreverse content))))
(buffer-substring-no-properties (bibtex-start-of-text-in-field bounds)
(bibtex-end-of-text-in-field bounds))))
@@ -2239,8 +2242,9 @@ Optional arg BEG is beginning of entry."
Optional arg COMMA is as in `bibtex-enclosing-field'."
(unless bibtex-last-kill-command (error "BibTeX kill ring is empty"))
(let ((fun (lambda (kryp kr) ; adapted from `current-kill'
- (car (set kryp (nthcdr (mod (- n (length (eval kryp)))
- (length kr)) kr))))))
+ (car (set kryp (nthcdr (mod (- n (length (symbol-value kryp)))
+ (length kr))
+ kr))))))
;; We put the mark at the beginning of the inserted field or entry
;; and point at its end - a behavior similar to what `yank' does.
;; The mark is then used by `bibtex-yank-pop', which needs to know
@@ -2251,7 +2255,8 @@ Optional arg COMMA is as in `bibtex-enclosing-field'."
(goto-char (bibtex-end-of-field (bibtex-enclosing-field comma)))
(push-mark)
(bibtex-make-field (funcall fun 'bibtex-field-kill-ring-yank-pointer
- bibtex-field-kill-ring) t nil t))
+ bibtex-field-kill-ring)
+ t nil t))
;; insert past the current entry
(bibtex-skip-to-valid-entry)
(push-mark)
@@ -2615,7 +2620,7 @@ Return optimized value to be used by
`bibtex-format-entry'."
regexp-alist))
(let (opt-list)
;; Loop over field names
- (dolist (field (delete-dups (apply 'append (mapcar 'car regexp-alist))))
+ (dolist (field (delete-dups (apply #'append (mapcar #'car regexp-alist))))
(let (rules)
;; Collect all matches we have for this field name
(dolist (e regexp-alist)
@@ -2623,7 +2628,7 @@ Return optimized value to be used by
`bibtex-format-entry'."
(push (cons (nth 1 e) (nth 2 e)) rules)))
(if (eq type 'braces)
;; concatenate all regexps to a single regexp
- (setq rules (concat "\\(?:" (mapconcat 'car rules "\\|") "\\)")))
+ (setq rules (concat "\\(?:" (mapconcat #'car rules "\\|") "\\)")))
;; create list of replacement rules.
(push (cons field rules) opt-list)))
opt-list))
@@ -2674,7 +2679,7 @@ and `bibtex-autokey-names-stretch'."
(if (string= "" names)
names
(let* ((case-fold-search t)
- (name-list (mapcar 'bibtex-autokey-demangle-name
+ (name-list (mapcar #'bibtex-autokey-demangle-name
(split-string names "[ \t\n]+and[ \t\n]+")))
additional-names)
(unless (or (not (numberp bibtex-autokey-names))
@@ -2686,7 +2691,7 @@ and `bibtex-autokey-names-stretch'."
bibtex-autokey-names)
(nreverse name-list)))
additional-names bibtex-autokey-additional-names))
- (concat (mapconcat 'identity name-list
+ (concat (mapconcat #'identity name-list
bibtex-autokey-name-separator)
additional-names)))))
@@ -2736,7 +2741,7 @@ Return the result as a string."
;; specific words and use only a specific amount of words.
(let ((counter 0)
(ignore-re (concat "\\`\\(?:"
- (mapconcat 'identity
+ (mapconcat #'identity
bibtex-autokey-titleword-ignore "\\|")
"\\)\\'"))
titlewords titlewords-extra word)
@@ -2760,7 +2765,7 @@ Return the result as a string."
;; titlewords-extra in titlewords. Otherwise, we ignore
titlewords-extra.
(unless (string-match "\\b\\w+" titlestring)
(setq titlewords (append titlewords-extra titlewords)))
- (mapconcat 'bibtex-autokey-demangle-title (nreverse titlewords)
+ (mapconcat #'bibtex-autokey-demangle-title (nreverse titlewords)
bibtex-autokey-titleword-separator))))
(defun bibtex-autokey-demangle-title (titleword)
@@ -2837,7 +2842,7 @@ Concatenate the key:
non-empty insert `bibtex-autokey-name-year-separator' between the two.
If the title part and the year (or name) part are non-empty, insert
`bibtex-autokey-year-title-separator' between the two.
- 2. If `bibtex-autokey-before-presentation-function' is non-nil, it must be
+ 2. `bibtex-autokey-before-presentation-function' must be
a function taking one argument. Call this function with the generated
key as the argument. Use the return value of this function (a string)
as the key.
@@ -2865,7 +2870,7 @@ Concatenate the key:
(defun bibtex-global-key-alist ()
"Return global key alist based on `bibtex-files'."
(if bibtex-files
- (apply 'append
+ (apply #'append
(mapcar (lambda (buf)
(with-current-buffer buf bibtex-reference-keys))
;; include current buffer only if it uses `bibtex-mode'
@@ -3129,7 +3134,7 @@ does not use `bibtex-mode'."
(if buffer-list
(switch-to-buffer
(completing-read "Switch to BibTeX buffer: "
- (mapcar 'buffer-name buffer-list)
+ (mapcar #'buffer-name buffer-list)
nil t
(if current (buffer-name (current-buffer)))))
(message "No BibTeX buffers defined")))
@@ -3178,7 +3183,7 @@ that is generated by calling `bibtex-url'."
Used as default value of `bibtex-summary-function'."
;; It would be neat to make this function customizable. How?
(if (looking-at bibtex-entry-maybe-empty-head)
- (let* ((bibtex-autokey-name-case-convert-function 'identity)
+ (let* ((bibtex-autokey-name-case-convert-function #'identity)
(bibtex-autokey-name-length 'infty)
(bibtex-autokey-names 1)
(bibtex-autokey-names-stretch 0)
@@ -3189,7 +3194,7 @@ Used as default value of `bibtex-summary-function'."
(year (bibtex-autokey-get-year))
(bibtex-autokey-titlewords 5)
(bibtex-autokey-titlewords-stretch 2)
- (bibtex-autokey-titleword-case-convert-function 'identity)
+ (bibtex-autokey-titleword-case-convert-function #'identity)
(bibtex-autokey-titleword-length 5)
(bibtex-autokey-titleword-separator " ")
(title (bibtex-autokey-get-title))
@@ -3336,12 +3341,12 @@ BOUND limits the search."
(define-button-type 'bibtex-url
'action 'bibtex-button-action
- 'bibtex-function 'bibtex-url
+ 'bibtex-function #'bibtex-url
'help-echo (purecopy "mouse-2, RET: follow URL"))
(define-button-type 'bibtex-search-crossref
'action 'bibtex-button-action
- 'bibtex-function 'bibtex-search-crossref
+ 'bibtex-function #'bibtex-search-crossref
'help-echo (purecopy "mouse-2, RET: follow crossref"))
(defun bibtex-button (beg end type &rest args)
@@ -3405,7 +3410,7 @@ if that value is non-nil.
\\{bibtex-mode-map}"
(add-hook 'completion-at-point-functions
- 'bibtex-completion-at-point-function nil 'local)
+ #'bibtex-completion-at-point-function nil 'local)
(make-local-variable 'bibtex-buffer-last-parsed-tick)
;; Install stealthy parse function if not already installed
(unless bibtex-parse-idle-timer
@@ -3419,7 +3424,7 @@ if that value is non-nil.
(set (make-local-variable 'comment-column) 0)
(set (make-local-variable 'defun-prompt-regexp) "^[ \t]*@[[:alnum:]]+[ \t]*")
(set (make-local-variable 'outline-regexp) "[ \t]*@")
- (set (make-local-variable 'fill-paragraph-function) 'bibtex-fill-field)
+ (set (make-local-variable 'fill-paragraph-function) #'bibtex-fill-field)
(set (make-local-variable 'fill-prefix)
(make-string (+ bibtex-entry-offset bibtex-contline-indentation) ?\s))
(set (make-local-variable 'font-lock-defaults)
@@ -3441,7 +3446,7 @@ if that value is non-nil.
(syntax-propertize-via-font-lock
bibtex-font-lock-syntactic-keywords))
;; Allow `bibtex-dialect' as a file-local variable.
- (add-hook 'hack-local-variables-hook 'bibtex-set-dialect nil t))
+ (add-hook 'hack-local-variables-hook #'bibtex-set-dialect nil t))
(defun bibtex-entry-alist (dialect)
"Return entry-alist for DIALECT."
@@ -3488,8 +3493,9 @@ are also bound buffer-locally if `bibtex-dialect' is
already buffer-local
in the current buffer (for example, as a file-local variable).
LOCAL is t for interactive calls."
(interactive (list (intern (completing-read "Dialect: "
- (mapcar 'list
bibtex-dialect-list)
- nil t)) t))
+ (mapcar #'list
bibtex-dialect-list)
+ nil t))
+ t))
(let ((setfun (if (or local (local-variable-p 'bibtex-dialect))
(lambda (var val) (set (make-local-variable var) val))
'set)))
@@ -3506,7 +3512,7 @@ LOCAL is t for interactive calls."
bibtex-dialect))))
(funcall setfun 'bibtex-entry-type
(concat "@[ \t]*\\(?:"
- (regexp-opt (mapcar 'car bibtex-entry-alist)) "\\)"))
+ (regexp-opt (mapcar #'car bibtex-entry-alist)) "\\)"))
(funcall setfun 'bibtex-entry-head
(concat "^[ \t]*\\(" bibtex-entry-type "\\)[ \t]*[({][ \t\n]*\\("
bibtex-reference-key "\\)"))
@@ -3516,7 +3522,7 @@ LOCAL is t for interactive calls."
(concat "^[ \t]*@[ \t]*\\(?:"
(regexp-opt
(append '("String" "Preamble")
- (mapcar 'car bibtex-entry-alist))) "\\)"))
+ (mapcar #'car bibtex-entry-alist))) "\\)"))
(setq imenu-generic-expression
(list (list nil bibtex-entry-head bibtex-key-in-head))
imenu-case-fold-search t)))
@@ -3549,11 +3555,13 @@ LOCAL is t for interactive calls."
(let* ((entry (car elt))
(fname (intern (format "bibtex-%s" entry))))
(unless (fboundp fname)
- (eval (list 'defun fname nil
- (format "Insert a template for a @%s entry; see also
`bibtex-entry'."
- entry)
- '(interactive "*")
- `(bibtex-entry ,entry))))
+ (defalias fname
+ (lambda ()
+ (:documentation
+ (format "Insert a template for a @%s entry; see also
`bibtex-entry'."
+ entry))
+ (interactive "*")
+ (bibtex-entry entry))))
;; Menu entries
(define-key menu-map (vector fname)
`(menu-item ,(or (nth 1 elt) (car elt)) ,fname))))
@@ -3608,8 +3616,8 @@ is non-nil."
(insert "@" entry-type (bibtex-entry-left-delimiter))
(if key (insert key))
(save-excursion
- (mapc 'bibtex-make-field (car field-list))
- (mapc 'bibtex-make-optional-field (cdr field-list))
+ (mapc #'bibtex-make-field (car field-list))
+ (mapc #'bibtex-make-optional-field (cdr field-list))
(if bibtex-comma-after-last-field
(insert ","))
(insert "\n")
@@ -3657,8 +3665,8 @@ When called interactively with a prefix arg, query for a
value of ENTRY-TYPE."
(insert (bibtex-field-left-delimiter)))
(goto-char end)))
(skip-chars-backward " \t\n")
- (mapc 'bibtex-make-field required)
- (mapc 'bibtex-make-optional-field optional)))))
+ (mapc #'bibtex-make-field required)
+ (mapc #'bibtex-make-optional-field optional)))))
(defun bibtex-parse-entry (&optional content keep-opt-alt)
"Parse entry at point, return an alist.
@@ -4980,7 +4988,8 @@ If mark is active reformat entries in region, if not in
whole buffer."
("Remove empty optional and alternative fields? " .
opts-or-alts)
("Remove delimiters around pure numerical fields? " .
numerical-fields)
(,(concat (if bibtex-comma-after-last-field "Insert"
"Remove")
- " comma at end of entry? ") . last-comma)
+ " comma at end of entry? ")
+ . last-comma)
("Replace double page dashes by single ones? " .
page-dashes)
("Delete whitespace at the beginning and end of
fields? " . whitespace)
("Inherit booktitle? " . inherit-booktitle)
@@ -5047,7 +5056,7 @@ entries from minibuffer."
(goto-char (point-max))
(message "Buffer is now parsable. Please save it.")))
-(define-obsolete-function-alias 'bibtex-complete 'completion-at-point "24.1")
+(define-obsolete-function-alias 'bibtex-complete #'completion-at-point "24.1")
(defun bibtex-completion-at-point-function ()
(let ((pnt (point))
(case-fold-search t)
@@ -5258,8 +5267,8 @@ Return the URL or nil if none can be generated."
;; If SCHEME is set up correctly,
;; we should never reach this point
(error "Match failed: %s" text)))
- (if fmt (apply 'format fmt (nreverse obj))
- (apply 'concat (nreverse obj)))))
+ (if fmt (apply #'format fmt (nreverse obj))
+ (apply #'concat (nreverse obj)))))
(if (called-interactively-p 'interactive) (message "%s" url))
(unless no-browse (browse-url url)))
(if (and (not url) (called-interactively-p 'interactive))
@@ -5289,10 +5298,11 @@ where FILE is the BibTeX file of ENTRY."
(list (completing-read
"Field: "
(delete-dups
- (apply 'append
+ (apply #'append
bibtex-user-optional-fields
- (mapcar (lambda (x) (mapcar 'car (apply 'append (nthcdr 2
x))))
- bibtex-entry-alist))) nil t)
+ (mapcar (lambda (x) (mapcar #'car (apply #'append (nthcdr 2
x))))
+ bibtex-entry-alist)))
+ nil t)
(read-string "Regexp: ")
(if bibtex-search-entry-globally
(not current-prefix-arg)
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 0d4a910..0035c5e 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -119,7 +119,6 @@
("cue" cue-before cue-after)
("cue-after" uri "none")
("cue-before" uri "none")
- ("direction" "ltr" "rtl")
("display" "inline" "block" "list-item" "inline-block" "table"
"inline-table" "table-row-group" "table-header-group"
"table-footer-group" "table-row" "table-column-group"
@@ -180,7 +179,6 @@
("stress" number)
("table-layout" "auto" "fixed")
("top" length percentage "auto")
- ("unicode-bidi" "normal" "embed" "bidi-override")
("vertical-align" "baseline" "sub" "super" "top" "text-top"
"middle" "bottom" "text-bottom" percentage length)
("visibility" "visible" "hidden" "collapse")
@@ -278,6 +276,10 @@
("color" color)
("opacity" alphavalue)
+ ;; CSS Containment Module Level 1
+ ;; (https://www.w3.org/TR/css-contain-1/#property-index)
+ ("contain" "none" "strict" "content" "size" "layout" "paint")
+
;; CSS Grid Layout Module Level 1
;; (https://www.w3.org/TR/css-grid-1/#property-index)
("grid" grid-template grid-template-rows "auto-flow" "dense"
@@ -490,6 +492,16 @@
;; (https://www.w3.org/TR/css-will-change-1/#property-index)
("will-change" "auto" animateable-feature)
+ ;; CSS Writing Modes Level 3
+ ;; (https://www.w3.org/TR/css-writing-modes-3/#property-index)
+ ;; "glyph-orientation-vertical" is obsolete and left out.
+ ("direction" "ltr" "rtl")
+ ("text-combine-upright" "none" "all")
+ ("text-orientation" "mixed" "upright" "sideways")
+ ("unicode-bidi" "normal" "embed" "isolate" "bidi-override"
+ "isolate-override" "plaintext")
+ ("writing-mode" "horizontal-tb" "vertical-rl" "vertical-lr")
+
;; Filter Effects Module Level 1
;; (http://www.w3.org/TR/filter-effects/#property-index)
("color-interpolation-filters" "auto" "sRGB" "linearRGB")
@@ -874,7 +886,7 @@ cannot be completed sensibly: `custom-ident',
(defconst css-escapes-re
"\\\\\\(?:[^\000-\037\177]\\|[[:xdigit:]]+[ \n\t\r\f]?\\)")
-(defconst css-nmchar-re (concat "\\(?:[-[:alnum:]]\\|" css-escapes-re "\\)"))
+(defconst css-nmchar-re (concat "\\(?:[-_[:alnum:]]\\|" css-escapes-re "\\)"))
(defconst css-nmstart-re (concat "\\(?:[[:alpha:]]\\|" css-escapes-re "\\)"))
(defconst css-ident-re ;; (concat css-nmstart-re css-nmchar-re "*")
;; Apparently, "at rules" names can start with a dash, e.g. @-moz-keyframes.
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 9b29b84..b5ff6a6 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -1852,8 +1852,8 @@ This takes effect when first loading the library.")
"Keymap for commands for use in HTML mode.")
(defvar html-face-tag-alist
- '((bold . "b")
- (italic . "i")
+ '((bold . "strong")
+ (italic . "em")
(underline . "u")
(mode-line . "rev"))
"Value of `sgml-face-tag-alist' for HTML mode.")
@@ -2363,7 +2363,7 @@ have <h1>Very Major Headlines</h1> through <h6>Very Minor
Headlines</h6>
<p>Paragraphs only need an opening tag. Line breaks and multiple spaces are
ignored unless the text is <pre>preformatted.</pre> Text can be marked as
-<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal M-o or
+<strong>bold</strong>, <em>italic</em> or <u>underlined</u> using the normal
M-o or
Edit/Text Properties/Face commands.
Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el
index a95606f..4ee7ee5 100644
--- a/lisp/vc/ediff-vers.el
+++ b/lisp/vc/ediff-vers.el
@@ -49,15 +49,10 @@ comparison or merge operations are being performed."
:group 'ediff-vers
)
-(defalias 'ediff-vc-revision-other-window
- (if (fboundp 'vc-revision-other-window)
- 'vc-revision-other-window
- 'vc-version-other-window))
-
-(defalias 'ediff-vc-working-revision
- (if (fboundp 'vc-working-revision)
- 'vc-working-revision
- 'vc-workfile-version))
+(define-obsolete-function-alias 'ediff-vc-revision-other-window
+ #'vc-revision-other-window "28.1")
+(define-obsolete-function-alias 'ediff-vc-working-revision
+ #'vc-working-revision "28.1")
;; VC.el support
@@ -88,12 +83,12 @@ comparison or merge operations are being performed."
(setq rev1 (ediff-vc-latest-version (buffer-file-name))))
(save-window-excursion
(save-excursion
- (ediff-vc-revision-other-window rev1)
+ (vc-revision-other-window rev1)
(setq rev1buf (current-buffer)
file1 (buffer-file-name)))
(save-excursion
(or (string= rev2 "") ; use current buffer
- (ediff-vc-revision-other-window rev2))
+ (vc-revision-other-window rev2))
(setq rev2buf (current-buffer)
file2 (buffer-file-name)))
(push (lambda ()
@@ -165,18 +160,18 @@ comparison or merge operations are being performed."
(let (buf1 buf2 ancestor-buf)
(save-window-excursion
(save-excursion
- (ediff-vc-revision-other-window rev1)
+ (vc-revision-other-window rev1)
(setq buf1 (current-buffer)))
(save-excursion
(or (string= rev2 "")
- (ediff-vc-revision-other-window rev2))
+ (vc-revision-other-window rev2))
(setq buf2 (current-buffer)))
(if ancestor-rev
(save-excursion
(if (string= ancestor-rev "")
- (setq ancestor-rev (ediff-vc-working-revision
+ (setq ancestor-rev (vc-working-revision
buffer-file-name)))
- (ediff-vc-revision-other-window ancestor-rev)
+ (vc-revision-other-window ancestor-rev)
(setq ancestor-buf (current-buffer))))
(push (let ((f1 (buffer-file-name buf1))
(f2 (unless (string= rev2 "") (buffer-file-name buf2)))
diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el
index 0c9e656..a86c37c 100644
--- a/lisp/vc/vc-dir.el
+++ b/lisp/vc/vc-dir.el
@@ -1106,6 +1106,7 @@ the *vc-dir* buffer.
(set (make-local-variable 'vc-dir-backend) use-vc-backend)
(set (make-local-variable 'desktop-save-buffer)
'vc-dir-desktop-buffer-misc-data)
+ (setq-local bookmark-make-record-function #'vc-dir-bookmark-make-record)
(setq buffer-read-only t)
(when (boundp 'tool-bar-map)
(set (make-local-variable 'tool-bar-map) vc-dir-tool-bar-map))
@@ -1466,6 +1467,41 @@ These are the commands available for use in the file
status buffer:
'(vc-dir-mode . vc-dir-restore-desktop-buffer))
+;;; Support for bookmark.el (adapted from what info.el does).
+
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-default-handler "bookmark" (bmk))
+(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+
+(defun vc-dir-bookmark-make-record ()
+ "Make record used to bookmark a `vc-dir' buffer.
+This implements the `bookmark-make-record-function' type for
+`vc-dir' buffers."
+ (let* ((bookmark-name
+ (concat "(" (symbol-name vc-dir-backend) ") "
+ (file-name-nondirectory
+ (directory-file-name default-directory))))
+ (defaults (list bookmark-name default-directory)))
+ `(,bookmark-name
+ ,@(bookmark-make-record-default 'no-file)
+ (filename . ,default-directory)
+ (handler . vc-dir-bookmark-jump)
+ (defaults . ,defaults))))
+
+;;;###autoload
+(defun vc-dir-bookmark-jump (bmk)
+ "Provides the bookmark-jump behavior for a `vc-dir' buffer.
+This implements the `handler' function interface for the record
+type returned by `vc-dir-bookmark-make-record'."
+ (let* ((file (bookmark-prop-get bmk 'filename))
+ (buf (save-window-excursion
+ (vc-dir file) (current-buffer))))
+ (bookmark-default-handler
+ `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk)))))
+
+
(provide 'vc-dir)
;;; vc-dir.el ends here
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 2caa287..dcb5228 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -72,6 +72,7 @@
;; by git, so it's probably
;; not a good idea.
;; - merge-news (file) see `merge-file'
+;; - mark-resolved (file) OK
;; - steal-lock (file &optional revision) NOT NEEDED
;; HISTORY FUNCTIONS
;; * print-log (files buffer &optional shortlog start-revision limit) OK
@@ -1530,6 +1531,9 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(defun vc-git-rename-file (old new)
(vc-git-command nil 0 (list old new) "mv" "-f" "--"))
+(defun vc-git-mark-resolved (files)
+ (vc-git-command nil 0 files "add"))
+
(defvar vc-git-extra-menu-map
(let ((map (make-sparse-keymap)))
(define-key map [git-grep]
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 2ca9d3e..ce72a49 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -498,7 +498,7 @@ status of this file. Otherwise, the value returned is one
of:
"Return the repository version from which FILE was checked out.
If FILE is not registered, this function always returns nil."
(or (vc-file-getprop file 'vc-working-revision)
- (progn
+ (let ((default-directory (file-name-directory file)))
(setq backend (or backend (vc-backend file)))
(when backend
(vc-file-setprop file 'vc-working-revision
diff --git a/lisp/version.el b/lisp/version.el
index 012cb21..b247232 100644
--- a/lisp/version.el
+++ b/lisp/version.el
@@ -1,4 +1,4 @@
-;;; version.el --- record version number of Emacs
+;;; version.el --- record version number of Emacs -*- lexical-binding:t -*-
;; Copyright (C) 1985, 1992, 1994-1995, 1999-2020 Free Software
;; Foundation, Inc.
@@ -123,7 +123,7 @@ or if we could not determine the revision.")
(looking-at "[[:xdigit:]]\\{40\\}"))
(match-string 0)))))
-(defun emacs-repository-get-version (&optional dir external)
+(defun emacs-repository-get-version (&optional dir _external)
"Try to return as a string the repository revision of the Emacs sources.
The format of the returned string is dependent on the VCS in use.
Value is nil if the sources do not seem to be under version
@@ -163,8 +163,4 @@ correspond to the running Emacs.
Optional argument DIR is a directory to use instead of `source-directory'."
(emacs-repository-branch-git (or dir source-directory)))
-;; We put version info into the executable in the form that `ident' uses.
-(purecopy (concat "\n$Id: " (subst-char-in-string ?\n ?\s (emacs-version))
- " $\n"))
-
;;; version.el ends here
diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el
index 307490d..642a484 100644
--- a/lisp/w32-vars.el
+++ b/lisp/w32-vars.el
@@ -1,4 +1,4 @@
-;;; w32-vars.el --- MS-Windows specific user options
+;;; w32-vars.el --- MS-Windows specific user options -*- lexical-binding:t -*-
;; Copyright (C) 2002-2020 Free Software Foundation, Inc.
@@ -44,22 +44,19 @@ after changing the value of this variable."
:type 'boolean
:set (lambda (symbol value)
(set symbol value)
- (setq mouse-appearance-menu-map nil))
- :group 'w32)
+ (setq mouse-appearance-menu-map nil)))
(unless (eq system-type 'cygwin)
(defcustom w32-allow-system-shell nil
"Disable startup warning when using \"system\" shells."
- :type 'boolean
- :group 'w32))
+ :type 'boolean))
(unless (eq system-type 'cygwin)
(defcustom w32-system-shells '("cmd" "cmd.exe" "command" "command.com"
"4nt" "4nt.exe" "4dos" "4dos.exe"
"tcc" "tcc.exe" "ndos" "ndos.exe")
"List of strings recognized as Windows system shells."
- :type '(repeat string)
- :group 'w32))
+ :type '(repeat string)))
;; Want "menu" custom type for this.
(defcustom w32-fixed-font-alist
@@ -149,8 +146,7 @@ menu if the variable `w32-use-w32-font-dialog' is nil."
(const :tag "Separator" (""))
(list :tag "Font Entry"
(string :tag "Menu text")
- (string :tag "Font")))))))
- :group 'w32)
+ (string :tag "Font"))))))))
(make-obsolete-variable 'w32-enable-synthesized-fonts nil "24.4")
diff --git a/lisp/window.el b/lisp/window.el
index 8512a0e..d658cb8 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -8638,16 +8638,32 @@ in some window."
(setq end (point-max)))
(if (= beg end)
0
- (save-excursion
- (save-restriction
- (widen)
- (narrow-to-region (min beg end)
- (if (and (not count-final-newline)
- (= ?\n (char-before (max beg end))))
- (1- (max beg end))
- (max beg end)))
- (goto-char (point-min))
- (1+ (vertical-motion (buffer-size) window))))))
+ (let ((start (min beg end))
+ (finish (max beg end))
+ count end-invisible-p)
+ ;; When END is invisible because lines are truncated in WINDOW,
+ ;; vertical-motion returns a number that is 1 larger than it
+ ;; should. We need to fix that.
+ (setq end-invisible-p
+ (and (or truncate-lines
+ (and (natnump truncate-partial-width-windows)
+ (< (window-total-width window)
+ truncate-partial-width-windows)))
+ (save-excursion
+ (goto-char finish)
+ (> (- (current-column) (window-hscroll window))
+ (window-body-width window)))))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (narrow-to-region start
+ (if (and (not count-final-newline)
+ (= ?\n (char-before finish)))
+ (1- finish)
+ finish))
+ (goto-char start)
+ (setq count (vertical-motion (buffer-size) window))
+ (if end-invisible-p count (1+ count)))))))
(defun window-buffer-height (window)
"Return the height (in screen lines) of the buffer that WINDOW is displaying.
diff --git a/lisp/xml.el b/lisp/xml.el
index dc774a2..10ef8e2 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -1023,9 +1023,18 @@ entity references (e.g., replace each & with &).
XML character data must not contain & or < characters, nor the >
character under some circumstances. The XML spec does not impose
restriction on \" or \\=', but we just substitute for these too
-\(as is permitted by the spec)."
+\(as is permitted by the spec).
+
+If STRING contains characters that are invalid in XML (as defined
+by https://www.w3.org/TR/xml/#charsets), signal an error of type
+`xml-invalid-character'."
(with-temp-buffer
(insert string)
+ (goto-char (point-min))
+ (when (re-search-forward
+
"[^\u0009\u000A\u000D\u0020-\uD7FF\uE000-\uFFFD\U00010000-\U0010FFFF]"
+ nil t)
+ (signal 'xml-invalid-character (list (char-before) (match-beginning 0))))
(dolist (substitution '(("&" . "&")
("<" . "<")
(">" . ">")
@@ -1036,6 +1045,9 @@ restriction on \" or \\=', but we just substitute for
these too
(replace-match (cdr substitution) t t nil)))
(buffer-string)))
+(define-error 'xml-invalid-character "Invalid XML character"
+ 'wrong-type-argument)
+
(defun xml-debug-print-internal (xml indent-string)
"Outputs the XML tree in the current buffer.
The first line is indented with INDENT-STRING."
diff --git a/m4/explicit_bzero.m4 b/m4/explicit_bzero.m4
index 507816a..a415e7b 100644
--- a/m4/explicit_bzero.m4
+++ b/m4/explicit_bzero.m4
@@ -19,4 +19,5 @@ AC_DEFUN([gl_FUNC_EXPLICIT_BZERO],
AC_DEFUN([gl_PREREQ_EXPLICIT_BZERO],
[
AC_CHECK_FUNCS([explicit_memset])
+ AC_CHECK_FUNCS_ONCE([memset_s])
])
diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4
index b4795c1..f4ba5e3 100644
--- a/m4/gnulib-common.m4
+++ b/m4/gnulib-common.m4
@@ -1,4 +1,4 @@
-# gnulib-common.m4 serial 48
+# gnulib-common.m4 serial 50
dnl Copyright (C) 2007-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -15,6 +15,15 @@ AC_DEFUN([gl_COMMON], [
AC_REQUIRE([gl_ZZGNULIB])
])
AC_DEFUN([gl_COMMON_BODY], [
+ AH_VERBATIM([_GL_GNUC_PREREQ],
+[/* True if the compiler says it groks GNU C version MAJOR.MINOR. */
+#if defined __GNUC__ && defined __GNUC_MINOR__
+# define _GL_GNUC_PREREQ(major, minor) \
+ ((major) < __GNUC__ + ((minor) <= __GNUC_MINOR__))
+#else
+# define _GL_GNUC_PREREQ(major, minor) 0
+#endif
+])
AH_VERBATIM([_Noreturn],
[/* The _Noreturn keyword of C11. */
#ifndef _Noreturn
@@ -31,12 +40,12 @@ AC_DEFUN([gl_COMMON_BODY], [
# define _Noreturn [[noreturn]]
# elif ((!defined __cplusplus || defined __clang__) \
&& (201112 <= (defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) \
- || 4 < __GNUC__ + (7 <= __GNUC_MINOR__) \
+ || _GL_GNUC_PREREQ (4, 7) \
|| (defined __apple_build_version__ \
? 6000000 <= __apple_build_version__ \
: 3 < __clang_major__ + (5 <= __clang_minor__))))
/* _Noreturn works as-is. */
-# elif 2 < __GNUC__ + (8 <= __GNUC_MINOR__) || 0x5110 <= __SUNPRO_C
+# elif _GL_GNUC_PREREQ (2, 8) || 0x5110 <= __SUNPRO_C
# define _Noreturn __attribute__ ((__noreturn__))
# elif 1200 <= (defined _MSC_VER ? _MSC_VER : 0)
# define _Noreturn __declspec (noreturn)
@@ -55,48 +64,206 @@ AC_DEFUN([gl_COMMON_BODY], [
#if defined __APPLE__ && defined __MACH__ && __APPLE_CC__ >= 5465 && !defined
__cplusplus && __STDC_VERSION__ >= 199901L && !defined __GNUC_STDC_INLINE__
# define __GNUC_STDC_INLINE__ 1
#endif])
- AH_VERBATIM([unused_parameter],
-[/* Define as a marker that can be attached to declarations that might not
- be used. This helps to reduce warnings, such as from
- GCC -Wunused-parameter. */
-#if __GNUC__ >= 3 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)
-# define _GL_UNUSED __attribute__ ((__unused__))
+ AH_VERBATIM([attribute],
+[/* Attributes. */
+#ifdef __has_attribute
+# define _GL_HAS_ATTRIBUTE(attr) __has_attribute (__##attr##__)
#else
-# define _GL_UNUSED
+# define _GL_HAS_ATTRIBUTE(attr) _GL_ATTR_##attr
+# define _GL_ATTR_alloc_size _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_always_inline _GL_GNUC_PREREQ (3, 2)
+# define _GL_ATTR_artificial _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_cold _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_const _GL_GNUC_PREREQ (2, 95)
+# define _GL_ATTR_deprecated _GL_GNUC_PREREQ (3, 1)
+# define _GL_ATTR_error _GL_GNUC_PREREQ (4, 3)
+# define _GL_ATTR_externally_visible _GL_GNUC_PREREQ (4, 1)
+# define _GL_ATTR_fallthrough _GL_GNUC_PREREQ (7, 0)
+# define _GL_ATTR_format _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_leaf _GL_GNUC_PREREQ (4, 6)
+# ifdef _ICC
+# define _GL_ATTR_may_alias 0
+# else
+# define _GL_ATTR_may_alias _GL_GNUC_PREREQ (3, 3)
+# endif
+# define _GL_ATTR_malloc _GL_GNUC_PREREQ (3, 0)
+# define _GL_ATTR_noinline _GL_GNUC_PREREQ (3, 1)
+# define _GL_ATTR_nonnull _GL_GNUC_PREREQ (3, 3)
+# define _GL_ATTR_nonstring _GL_GNUC_PREREQ (8, 0)
+# define _GL_ATTR_nothrow _GL_GNUC_PREREQ (3, 3)
+# define _GL_ATTR_packed _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_pure _GL_GNUC_PREREQ (2, 96)
+# define _GL_ATTR_returns_nonnull _GL_GNUC_PREREQ (4, 9)
+# define _GL_ATTR_sentinel _GL_GNUC_PREREQ (4, 0)
+# define _GL_ATTR_unused _GL_GNUC_PREREQ (2, 7)
+# define _GL_ATTR_warn_unused_result _GL_GNUC_PREREQ (3, 4)
#endif
-/* The name _UNUSED_PARAMETER_ is an earlier spelling, although the name
- is a misnomer outside of parameter lists. */
-#define _UNUSED_PARAMETER_ _GL_UNUSED
-
-/* gcc supports the "unused" attribute on possibly unused labels, and
- g++ has since version 4.5. Note to support C++ as well as C,
- _GL_UNUSED_LABEL should be used with a trailing ; */
-#if !defined __cplusplus || __GNUC__ > 4 \
- || (__GNUC__ == 4 && __GNUC_MINOR__ >= 5)
-# define _GL_UNUSED_LABEL _GL_UNUSED
+
+]dnl There is no _GL_ATTRIBUTE_ALIGNED; use stdalign's _Alignas instead.
+[
+#if _GL_HAS_ATTRIBUTE (alloc_size)
+# define _GL_ATTRIBUTE_ALLOC_SIZE(args) __attribute__ ((__alloc_size__ args))
#else
-# define _GL_UNUSED_LABEL
+# define _GL_ATTRIBUTE_ALLOC_SIZE(args)
#endif
-/* The __pure__ attribute was added in gcc 2.96. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 96)
-# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+#if _GL_HAS_ATTRIBUTE (always_inline)
+# define _GL_ATTRIBUTE_ALWAYS_INLINE __attribute__ ((__always_inline__))
#else
-# define _GL_ATTRIBUTE_PURE /* empty */
+# define _GL_ATTRIBUTE_ALWAYS_INLINE
#endif
-/* The __const__ attribute was added in gcc 2.95. */
-#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 95)
+#if _GL_HAS_ATTRIBUTE (artificial)
+# define _GL_ATTRIBUTE_ARTIFICIAL __attribute__ ((__artificial__))
+#else
+# define _GL_ATTRIBUTE_ARTIFICIAL
+#endif
+
+/* Avoid __attribute__ ((cold)) on MinGW; see thread starting at
+ <https://lists.gnu.org/r/emacs-devel/2019-04/msg01152.html>. */
+#if _GL_HAS_ATTRIBUTE (cold) && !defined __MINGW32__
+# define _GL_ATTRIBUTE_COLD __attribute__ ((__cold__))
+#else
+# define _GL_ATTRIBUTE_COLD
+#endif
+
+#if _GL_HAS_ATTRIBUTE (const)
# define _GL_ATTRIBUTE_CONST __attribute__ ((__const__))
#else
-# define _GL_ATTRIBUTE_CONST /* empty */
+# define _GL_ATTRIBUTE_CONST
#endif
-/* The __malloc__ attribute was added in gcc 3. */
-#if 3 <= __GNUC__
+#if 201710L < __STDC_VERSION__
+# define _GL_ATTRIBUTE_DEPRECATED [[__deprecated__]]
+#elif _GL_HAS_ATTRIBUTE (deprecated)
+# define _GL_ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__))
+#else
+# define _GL_ATTRIBUTE_DEPRECATED
+#endif
+
+#if _GL_HAS_ATTRIBUTE (error)
+# define _GL_ATTRIBUTE_ERROR(msg) __attribute__ ((__error__ (msg)))
+# define _GL_ATTRIBUTE_WARNING(msg) __attribute__ ((__warning__ (msg)))
+#else
+# define _GL_ATTRIBUTE_ERROR(msg)
+# define _GL_ATTRIBUTE_WARNING(msg)
+#endif
+
+#if _GL_HAS_ATTRIBUTE (externally_visible)
+# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE __attribute__ ((externally_visible))
+#else
+# define _GL_ATTRIBUTE_EXTERNALLY_VISIBLE
+#endif
+
+/* FALLTHROUGH is special, because it always expands to something. */
+#if 201710L < __STDC_VERSION__
+# define _GL_ATTRIBUTE_FALLTHROUGH [[__fallthrough__]]
+#elif _GL_HAS_ATTRIBUTE (fallthrough)
+# define _GL_ATTRIBUTE_FALLTHROUGH __attribute__ ((__fallthrough__))
+#else
+# define _GL_ATTRIBUTE_FALLTHROUGH ((void) 0)
+#endif
+
+#if _GL_HAS_ATTRIBUTE (format)
+# define _GL_ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
+#else
+# define _GL_ATTRIBUTE_FORMAT(spec)
+#endif
+
+#if _GL_HAS_ATTRIBUTE (leaf)
+# define _GL_ATTRIBUTE_LEAF __attribute__ ((__leaf__))
+#else
+# define _GL_ATTRIBUTE_LEAF
+#endif
+
+#if _GL_HAS_ATTRIBUTE (may_alias)
+# define _GL_ATTRIBUTE_MAY_ALIAS __attribute__ ((__may_alias__))
+#else
+# define _GL_ATTRIBUTE_MAY_ALIAS
+#endif
+
+#if 201710L < __STDC_VERSION__
+# define _GL_ATTRIBUTE_MAYBE_UNUSED [[__maybe_unused__]]
+#elif _GL_HAS_ATTRIBUTE (unused)
+# define _GL_ATTRIBUTE_MAYBE_UNUSED __attribute__ ((__unused__))
+#else
+# define _GL_ATTRIBUTE_MAYBE_UNUSED
+#endif
+/* Earlier spellings of this macro. */
+#define _GL_UNUSED _GL_ATTRIBUTE_MAYBE_UNUSED
+#define _UNUSED_PARAMETER_ _GL_ATTRIBUTE_MAYBE_UNUSED
+
+#if _GL_HAS_ATTRIBUTE (malloc)
# define _GL_ATTRIBUTE_MALLOC __attribute__ ((__malloc__))
#else
-# define _GL_ATTRIBUTE_MALLOC /* empty */
+# define _GL_ATTRIBUTE_MALLOC
+#endif
+
+#if 201710L < __STDC_VERSION__
+# define _GL_ATTRIBUTE_NODISCARD [[__nodiscard__]]
+#elif _GL_HAS_ATTRIBUTE (warn_unused_result)
+# define _GL_ATTRIBUTE_NODISCARD __attribute__ ((__warn_unused_result__))
+#else
+# define _GL_ATTRIBUTE_NODISCARD
+#endif
+
+#if _GL_HAS_ATTRIBUTE (noinline)
+# define _GL_ATTRIBUTE_NOINLINE __attribute__ ((__noinline__))
+#else
+# define _GL_ATTRIBUTE_NOINLINE
+#endif
+
+#if _GL_HAS_ATTRIBUTE (nonnull)
+# define _GL_ATTRIBUTE_NONNULL(args) __attribute__ ((__nonnull__ args))
+#else
+# define _GL_ATTRIBUTE_NONNULL(args)
+#endif
+
+#if _GL_HAS_ATTRIBUTE (nonstring)
+# define _GL_ATTRIBUTE_NONSTRING __attribute__ ((__nonstring__))
+#else
+# define _GL_ATTRIBUTE_NONSTRING
+#endif
+
+/* There is no _GL_ATTRIBUTE_NORETURN; use _Noreturn instead. */
+
+#if _GL_HAS_ATTRIBUTE (nothrow) && !defined __cplusplus
+# define _GL_ATTRIBUTE_NOTHROW __attribute__ ((__nothrow__))
+#else
+# define _GL_ATTRIBUTE_NOTHROW
+#endif
+
+#if _GL_HAS_ATTRIBUTE (packed)
+# define _GL_ATTRIBUTE_PACKED __attribute__ ((__packed__))
+#else
+# define _GL_ATTRIBUTE_PACKED
+#endif
+
+#if _GL_HAS_ATTRIBUTE (pure)
+# define _GL_ATTRIBUTE_PURE __attribute__ ((__pure__))
+#else
+# define _GL_ATTRIBUTE_PURE
+#endif
+
+#if _GL_HAS_ATTRIBUTE (returns_nonnull)
+# define _GL_ATTRIBUTE_RETURNS_NONNULL __attribute__ ((__returns_nonnull__))
+#else
+# define _GL_ATTRIBUTE_RETURNS_NONNULL
+#endif
+
+#if _GL_HAS_ATTRIBUTE (sentinel)
+# define _GL_ATTRIBUTE_SENTINEL(pos) __attribute__ ((__sentinel__ pos))
+#else
+# define _GL_ATTRIBUTE_SENTINEL(pos)
+#endif
+
+]dnl There is no _GL_ATTRIBUTE_VISIBILITY; see m4/visibility.m4 instead.
+[
+/* To support C++ as well as C, use _GL_UNUSED_LABEL with trailing ';'. */
+#if !defined __cplusplus || _GL_GNUC_PREREQ (4, 5)
+# define _GL_UNUSED_LABEL _GL_ATTRIBUTE_MAYBE_UNUSED
+#else
+# define _GL_UNUSED_LABEL
#endif
])
AH_VERBATIM([async_safe],
diff --git a/m4/gnulib-comp.m4 b/m4/gnulib-comp.m4
index d5faa9a..3717024 100644
--- a/m4/gnulib-comp.m4
+++ b/m4/gnulib-comp.m4
@@ -47,6 +47,7 @@ AC_DEFUN([gl_EARLY],
# Code from module alloca-opt:
# Code from module allocator:
# Code from module at-internal:
+ # Code from module attribute:
# Code from module binary-io:
# Code from module builtin-expect:
# Code from module byteswap:
@@ -934,6 +935,7 @@ AC_DEFUN([gl_FILE_LIST], [
lib/allocator.h
lib/arg-nonnull.h
lib/at-func.c
+ lib/attribute.h
lib/binary-io.c
lib/binary-io.h
lib/byteswap.in.h
diff --git a/m4/manywarnings.m4 b/m4/manywarnings.m4
index 783620d..719bafb 100644
--- a/m4/manywarnings.m4
+++ b/m4/manywarnings.m4
@@ -1,4 +1,4 @@
-# manywarnings.m4 serial 18
+# manywarnings.m4 serial 19
dnl Copyright (C) 2008-2020 Free Software Foundation, Inc.
dnl This file is free software; the Free Software Foundation
dnl gives unlimited permission to copy and/or distribute it,
@@ -117,6 +117,23 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
-Waddress-of-packed-member \
-Waggressive-loop-optimizations \
-Wall \
+ -Wanalyzer-double-fclose \
+ -Wanalyzer-double-free \
+ -Wanalyzer-exposure-through-output-file \
+ -Wanalyzer-file-leak \
+ -Wanalyzer-free-of-non-heap \
+ -Wanalyzer-malloc-leak \
+ -Wanalyzer-null-argument \
+ -Wanalyzer-null-dereference \
+ -Wanalyzer-possible-null-argument \
+ -Wanalyzer-possible-null-dereference \
+ -Wanalyzer-stale-setjmp-buffer \
+ -Wanalyzer-tainted-array-index \
+ -Wanalyzer-too-complex \
+ -Wanalyzer-unsafe-call-within-signal-handler \
+ -Wanalyzer-use-after-free \
+ -Wanalyzer-use-of-pointer-in-stale-stack-frame \
+ -Warith-conversion \
-Wattribute-warning \
-Wattributes \
-Wbad-function-cast \
@@ -150,9 +167,11 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
-Wempty-body \
-Wendif-labels \
-Wenum-compare \
+ -Wenum-conversion \
-Wexpansion-to-defined \
-Wextra \
-Wformat-contains-nul \
+ -Wformat-diag \
-Wformat-extra-args \
-Wformat-nonliteral \
-Wformat-security \
@@ -231,6 +250,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
-Wstrict-aliasing \
-Wstrict-overflow \
-Wstrict-prototypes \
+ -Wstring-compare \
-Wstringop-truncation \
-Wsuggest-attribute=cold \
-Wsuggest-attribute=const \
@@ -242,6 +262,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
-Wsuggest-final-types \
-Wswitch \
-Wswitch-bool \
+ -Wswitch-outside-range \
-Wswitch-unreachable \
-Wsync-nand \
-Wsystem-headers \
@@ -269,6 +290,7 @@ m4_defun([gl_MANYWARN_ALL_GCC(C)],
-Wvla \
-Wvolatile-register-var \
-Wwrite-strings \
+ -Wzero-length-bounds \
\
; do
gl_manywarn_set="$gl_manywarn_set $gl_manywarn_item"
diff --git a/src/alloc.c b/src/alloc.c
index cc9ba8d..f860939 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -104,6 +104,46 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "w32heap.h" /* for sbrk */
#endif
+/* A type with alignment at least as large as any object that Emacs
+ allocates. This is not max_align_t because some platforms (e.g.,
+ mingw) have buggy malloc implementations that do not align for
+ max_align_t. This union contains types of all GCALIGNED_STRUCT
+ components visible here. */
+union emacs_align_type
+{
+ struct frame frame;
+ struct Lisp_Bignum Lisp_Bignum;
+ struct Lisp_Bool_Vector Lisp_Bool_Vector;
+ struct Lisp_Char_Table Lisp_Char_Table;
+ struct Lisp_CondVar Lisp_CondVar;
+ struct Lisp_Finalizer Lisp_Finalizer;
+ struct Lisp_Float Lisp_Float;
+ struct Lisp_Hash_Table Lisp_Hash_Table;
+ struct Lisp_Marker Lisp_Marker;
+ struct Lisp_Misc_Ptr Lisp_Misc_Ptr;
+ struct Lisp_Mutex Lisp_Mutex;
+ struct Lisp_Overlay Lisp_Overlay;
+ struct Lisp_Sub_Char_Table Lisp_Sub_Char_Table;
+ struct Lisp_Subr Lisp_Subr;
+ struct Lisp_User_Ptr Lisp_User_Ptr;
+ struct Lisp_Vector Lisp_Vector;
+ struct terminal terminal;
+ struct thread_state thread_state;
+ struct window window;
+
+ /* Omit the following since they would require including process.h
+ etc. In practice their alignments never exceed that of the
+ structs already listed. */
+#if 0
+ struct Lisp_Module_Function Lisp_Module_Function;
+ struct Lisp_Process Lisp_Process;
+ struct save_window_data save_window_data;
+ struct scroll_bar scroll_bar;
+ struct xwidget_view xwidget_view;
+ struct xwidget xwidget;
+#endif
+};
+
/* MALLOC_SIZE_NEAR (N) is a good number to pass to malloc when
allocating a block of memory with size close to N bytes.
For best results N should be a power of 2.
@@ -112,9 +152,9 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
adds sizeof (size_t) to SIZE for internal overhead, and then rounds
up to a multiple of MALLOC_ALIGNMENT. Emacs can improve
performance a bit on GNU platforms by arranging for the resulting
- size to be a power of two. This heuristic is good for glibc 2.0
- (1997) through at least glibc 2.31 (2020), and does not affect
- correctness on other platforms. */
+ size to be a power of two. This heuristic is good for glibc 2.26
+ (2017) and later, and does not affect correctness on other
+ platforms. */
#define MALLOC_SIZE_NEAR(n) \
(ROUNDUP (max (n, sizeof (size_t)), MALLOC_ALIGNMENT) - sizeof (size_t))
@@ -655,25 +695,19 @@ buffer_memory_full (ptrdiff_t nbytes)
#define COMMON_MULTIPLE(a, b) \
((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))
-/* LISP_ALIGNMENT is the alignment of Lisp objects. It must be at
- least GCALIGNMENT so that pointers can be tagged. It also must be
- at least as strict as the alignment of all the C types used to
- implement Lisp objects; since pseudovectors can contain any C type,
- this is max_align_t. On recent GNU/Linux x86 and x86-64 this can
- often waste up to 8 bytes, since alignof (max_align_t) is 16 but
- typical vectors need only an alignment of 8. Although shrinking
- the alignment to 8 would save memory, it cost a 20% hit to Emacs
- CPU performance on Fedora 28 x86-64 when compiled with gcc -m32. */
-enum { LISP_ALIGNMENT = alignof (union { max_align_t x;
+/* Alignment needed for memory blocks that are allocated via malloc
+ and that contain Lisp objects. On typical hosts malloc already
+ aligns sufficiently, but extra work is needed on oddball hosts
+ where Emacs would crash if malloc returned a non-GCALIGNED pointer. */
+enum { LISP_ALIGNMENT = alignof (union { union emacs_align_type x;
GCALIGNED_UNION_MEMBER }) };
verify (LISP_ALIGNMENT % GCALIGNMENT == 0);
/* True if malloc (N) is known to return storage suitably aligned for
Lisp objects whenever N is a multiple of LISP_ALIGNMENT. In
practice this is true whenever alignof (max_align_t) is also a
- multiple of LISP_ALIGNMENT. This works even for x86, where some
- platform combinations (e.g., GCC 7 and later, glibc 2.25 and
- earlier) have bugs where alignof (max_align_t) is 16 even though
+ multiple of LISP_ALIGNMENT. This works even for buggy platforms
+ like MinGW circa 2020, where alignof (max_align_t) is 16 even though
the malloc alignment is only 8, and where Emacs still works because
it never does anything that requires an alignment of 16. */
enum { MALLOC_IS_LISP_ALIGNED = alignof (max_align_t) % LISP_ALIGNMENT == 0 };
@@ -3421,23 +3455,6 @@ usage: (vector &rest OBJECTS) */)
return val;
}
-void
-make_byte_code (struct Lisp_Vector *v)
-{
- /* Don't allow the global zero_vector to become a byte code object. */
- eassert (0 < v->header.size);
-
- if (v->header.size > 1 && STRINGP (v->contents[1])
- && STRING_MULTIBYTE (v->contents[1]))
- /* BYTECODE-STRING must have been produced by Emacs 20.2 or the
- earlier because they produced a raw 8-bit string for byte-code
- and now such a byte-code string is loaded as multibyte while
- raw 8-bit characters converted to multibyte form. Thus, now we
- must convert them back to the original unibyte form. */
- v->contents[1] = Fstring_as_unibyte (v->contents[1]);
- XSETPVECTYPE (v, PVEC_COMPILED);
-}
-
DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
doc: /* Create a byte-code object with specified arguments as elements.
The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant
@@ -3456,8 +3473,14 @@ stack before executing the byte-code.
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING
INTERACTIVE-SPEC &rest ELEMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
- Lisp_Object val = make_uninit_vector (nargs);
- struct Lisp_Vector *p = XVECTOR (val);
+ if (! ((FIXNUMP (args[COMPILED_ARGLIST])
+ || CONSP (args[COMPILED_ARGLIST])
+ || NILP (args[COMPILED_ARGLIST]))
+ && STRINGP (args[COMPILED_BYTECODE])
+ && !STRING_MULTIBYTE (args[COMPILED_BYTECODE])
+ && VECTORP (args[COMPILED_CONSTANTS])
+ && FIXNATP (args[COMPILED_STACK_DEPTH])))
+ error ("Invalid byte-code object");
/* We used to purecopy everything here, if purify-flag was set. This worked
OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
@@ -3466,10 +3489,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH
&optional DOCSTRING INT
copied into pure space, including its free variables, which is sometimes
just wasteful and other times plainly wrong (e.g. those free vars may want
to be setcar'd). */
-
- memcpy (p->contents, args, nargs * sizeof *args);
- make_byte_code (p);
- XSETCOMPILED (val, p);
+ Lisp_Object val = Fvector (nargs, args);
+ XSETPVECTYPE (XVECTOR (val), PVEC_COMPILED);
return val;
}
@@ -4670,12 +4691,12 @@ mark_maybe_objects (Lisp_Object const *array, ptrdiff_t
nelts)
collected, and false otherwise (i.e., false if it is easy to see
that P cannot point to Lisp data that can be garbage collected).
Symbols are implemented via offsets not pointers, but the offsets
- are also multiples of LISP_ALIGNMENT. */
+ are also multiples of GCALIGNMENT. */
static bool
maybe_lisp_pointer (void *p)
{
- return (uintptr_t) p % LISP_ALIGNMENT == 0;
+ return (uintptr_t) p % GCALIGNMENT == 0;
}
/* If P points to Lisp data, mark that as live if it isn't already
@@ -4898,9 +4919,10 @@ test_setjmp (void)
as a stack scan limit. */
typedef union
{
- /* Align the stack top properly. Even if !HAVE___BUILTIN_UNWIND_INIT,
- jmp_buf may not be aligned enough on darwin-ppc64. */
- max_align_t o;
+ /* Make sure stack_top and m_stack_bottom are properly aligned as GC
+ expects. */
+ Lisp_Object o;
+ void *p;
#ifndef HAVE___BUILTIN_UNWIND_INIT
sys_jmp_buf j;
char c;
@@ -4944,12 +4966,10 @@ typedef union
#ifdef HAVE___BUILTIN_UNWIND_INIT
# define SET_STACK_TOP_ADDRESS(p) \
stacktop_sentry sentry; \
- __builtin_unwind_init (); \
*(p) = NEAR_STACK_TOP (&sentry)
#else
# define SET_STACK_TOP_ADDRESS(p) \
stacktop_sentry sentry; \
- __builtin_unwind_init (); \
test_setjmp (); \
sys_setjmp (sentry.j); \
*(p) = NEAR_STACK_TOP (&sentry + (stack_bottom < &sentry.c))
@@ -5013,8 +5033,9 @@ mark_stack (char const *bottom, char const *end)
#endif
}
-/* This is a trampoline function that flushes registers to the stack,
- and then calls FUNC. ARG is passed through to FUNC verbatim.
+/* flush_stack_call_func is the trampoline function that flushes
+ registers to the stack, and then calls FUNC. ARG is passed through
+ to FUNC verbatim.
This function must be called whenever Emacs is about to release the
global interpreter lock. This lets the garbage collector easily
@@ -5022,10 +5043,23 @@ mark_stack (char const *bottom, char const *end)
Lisp.
It is invalid to run any Lisp code or to allocate any GC memory
- from FUNC. */
+ from FUNC.
+
+ Note: all register spilling is done in flush_stack_call_func before
+ flush_stack_call_func1 is activated.
+
+ flush_stack_call_func1 is responsible for identifying the stack
+ address range to be scanned. It *must* be carefully kept as
+ noinline to make sure that registers has been spilled before it is
+ called, otherwise given __builtin_frame_address (0) typically
+ returns the frame pointer (base pointer) and not the stack pointer
+ [1] GC will miss to scan callee-saved registers content
+ (Bug#41357).
+
+ [1] <https://gcc.gnu.org/onlinedocs/gcc/Return-Address.html>. */
NO_INLINE void
-flush_stack_call_func (void (*func) (void *arg), void *arg)
+flush_stack_call_func1 (void (*func) (void *arg), void *arg)
{
void *end;
struct thread_state *self = current_thread;
diff --git a/src/bignum.h b/src/bignum.h
index ad9021f..4a906c3 100644
--- a/src/bignum.h
+++ b/src/bignum.h
@@ -108,7 +108,8 @@ bignum_integer (mpz_t *tmp, Lisp_Object i)
if (FIXNUMP (i))
{
mpz_set_intmax (*tmp, XFIXNUM (i));
- return tmp;
+ /* The unnecessary cast pacifies a buggy GCC 4.8.5. */
+ return (mpz_t const *) tmp;
}
return xbignum_val (i);
}
diff --git a/src/buffer.c b/src/buffer.c
index 53b3bd9..f1cb4d5 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -119,6 +119,7 @@ static void free_buffer_text (struct buffer *b);
static struct Lisp_Overlay * copy_overlays (struct buffer *, struct
Lisp_Overlay *);
static void modify_overlay (struct buffer *, ptrdiff_t, ptrdiff_t);
static Lisp_Object buffer_lisp_local_variables (struct buffer *, bool);
+static Lisp_Object buffer_local_variables_1 (struct buffer *buf, int offset,
Lisp_Object sym);
static void
CHECK_OVERLAY (Lisp_Object x)
@@ -1300,6 +1301,25 @@ buffer_lisp_local_variables (struct buffer *buf, bool
clone)
return result;
}
+
+/* If the variable at position index OFFSET in buffer BUF has a
+ buffer-local value, return (name . value). If SYM is non-nil,
+ it replaces name. */
+
+static Lisp_Object
+buffer_local_variables_1 (struct buffer *buf, int offset, Lisp_Object sym)
+{
+ int idx = PER_BUFFER_IDX (offset);
+ if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
+ && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
+ {
+ sym = NILP (sym) ? PER_BUFFER_SYMBOL (offset) : sym;
+ Lisp_Object val = per_buffer_value (buf, offset);
+ return EQ (val, Qunbound) ? sym : Fcons (sym, val);
+ }
+ return Qnil;
+}
+
DEFUN ("buffer-local-variables", Fbuffer_local_variables,
Sbuffer_local_variables, 0, 1, 0,
doc: /* Return an alist of variables that are buffer-local in BUFFER.
@@ -1311,25 +1331,25 @@ No argument or nil as argument means use current buffer
as BUFFER. */)
{
struct buffer *buf = decode_buffer (buffer);
Lisp_Object result = buffer_lisp_local_variables (buf, 0);
+ Lisp_Object tem;
/* Add on all the variables stored in special slots. */
{
- int offset, idx;
+ int offset;
FOR_EACH_PER_BUFFER_OBJECT_AT (offset)
{
- idx = PER_BUFFER_IDX (offset);
- if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
- && SYMBOLP (PER_BUFFER_SYMBOL (offset)))
- {
- Lisp_Object sym = PER_BUFFER_SYMBOL (offset);
- Lisp_Object val = per_buffer_value (buf, offset);
- result = Fcons (EQ (val, Qunbound) ? sym : Fcons (sym, val),
- result);
- }
+ tem = buffer_local_variables_1 (buf, offset, Qnil);
+ if (!NILP (tem))
+ result = Fcons (tem, result);
}
}
+ tem = buffer_local_variables_1 (buf, PER_BUFFER_VAR_OFFSET (undo_list),
+ intern ("buffer-undo-list"));
+ if (!NILP (tem))
+ result = Fcons (tem, result);
+
return result;
}
diff --git a/src/bytecode.c b/src/bytecode.c
index b4b5ef6..6b7e9cb 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -319,6 +319,19 @@ the third, MAXDEPTH, the maximum stack depth used in this
function.
If the third argument is incorrect, Emacs may crash. */)
(Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
{
+ if (! (STRINGP (bytestr) && VECTORP (vector) && FIXNATP (maxdepth)))
+ error ("Invalid byte-code");
+
+ if (STRING_MULTIBYTE (bytestr))
+ {
+ /* BYTESTR must have been produced by Emacs 20.2 or earlier
+ because it produced a raw 8-bit string for byte-code and now
+ such a byte-code string is loaded as multibyte with raw 8-bit
+ characters converted to multibyte form. Convert them back to
+ the original unibyte form. */
+ bytestr = Fstring_as_unibyte (bytestr);
+ }
+
return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
}
@@ -344,21 +357,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector,
Lisp_Object maxdepth,
int volatile this_op = 0;
#endif
- CHECK_STRING (bytestr);
- CHECK_VECTOR (vector);
- CHECK_FIXNAT (maxdepth);
+ eassert (!STRING_MULTIBYTE (bytestr));
ptrdiff_t const_length = ASIZE (vector);
-
- if (STRING_MULTIBYTE (bytestr))
- /* BYTESTR must have been produced by Emacs 20.2 or the earlier
- because they produced a raw 8-bit string for byte-code and now
- such a byte-code string is loaded as multibyte while raw 8-bit
- characters converted to multibyte form. Thus, now we must
- convert them back to the originally intended unibyte form. */
- bytestr = Fstring_as_unibyte (bytestr);
-
- ptrdiff_t bytestr_length = SBYTES (bytestr);
+ ptrdiff_t bytestr_length = SCHARS (bytestr);
Lisp_Object *vectorp = XVECTOR (vector)->contents;
unsigned char quitcounter = 1;
diff --git a/src/character.h b/src/character.h
index d4d7750..af5023f 100644
--- a/src/character.h
+++ b/src/character.h
@@ -317,30 +317,30 @@ multibyte_length (unsigned char const *p, unsigned char
const *pend,
return 1;
if (!check || p + 1 < pend)
{
- /* The 'unsigned int' avoids int overflow in the 5-byte case. */
- unsigned int d = p[1];
-
- if (TRAILING_CODE_P (d))
+ unsigned char d = p[1];
+ int w = ((d & 0xC0) << 2) + c;
+ if ((allow_8bit ? 0x2C0 : 0x2C2) <= w && w <= 0x2DF)
+ return 2;
+ if (!check || p + 2 < pend)
{
- if (allow_8bit ? (c & 0xE0) == 0xC0 : 0xC2 <= c && c <= 0xDF)
- return 2;
- if ((!check || p + 2 < pend)
- && TRAILING_CODE_P (p[2]))
+ unsigned char e = p[2];
+ w += (e & 0xC0) << 4;
+ int w1 = w | ((d & 0x20) >> 2);
+ if (0xAE1 <= w1 && w1 <= 0xAEF)
+ return 3;
+ if (!check || p + 3 < pend)
{
- if ((c & 0xF0) == 0xE0 && ((c & 0x0F) | (d & 0x20)))
- return 3;
- if ((!check || p + 3 < pend) && TRAILING_CODE_P (p[3]))
+ unsigned char f = p[3];
+ w += (f & 0xC0) << 6;
+ int w2 = w | ((d & 0x30) >> 3);
+ if (0x2AF1 <= w2 && w2 <= 0x2AF7)
+ return 4;
+ if (!check || p + 4 < pend)
{
- if ((c & 0xF8) == 0xF0 && ((c & 0x07) | (d & 0x30)))
- return 4;
- if (c == 0xF8 && (!check || p + 4 < pend)
- && TRAILING_CODE_P (p[4]))
- {
- unsigned int w = ((d << 24) + (p[2] << 16)
- + (p[3] << 8) + p[4]);
- if (0x88808080 <= w && w <= 0x8FBFBDBF)
- return 5;
- }
+ int_fast64_t lw = w + ((p[4] & 0xC0) << 8),
+ w3 = (lw << 24) + (d << 16) + (e << 8) + f;
+ if (0xAAF8888080 <= w3 && w3 <= 0xAAF88FBFBD)
+ return 5;
}
}
}
diff --git a/src/conf_post.h b/src/conf_post.h
index 8a6b329..1ef4ff3 100644
--- a/src/conf_post.h
+++ b/src/conf_post.h
@@ -30,13 +30,15 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#endif
/* To help make dependencies clearer elsewhere, this file typically
- does not #include other files. The exceptions are first stdbool.h
+ does not #include other files. The exceptions are stdbool.h
because it is unlikely to interfere with configuration and bool is
- such a core part of the C language, and second ms-w32.h (DOS_NT
+ such a core part of the C language, attribute.h because its
+ ATTRIBUTE_* macros are used here, and ms-w32.h (DOS_NT
only) because it historically was included here and changing that
would take some work. */
#include <stdbool.h>
+#include <attribute.h>
#if defined WINDOWSNT && !defined DEFER_MS_W32_H
# include <ms-w32.h>
@@ -65,31 +67,31 @@ typedef unsigned int bool_bf;
typedef bool bool_bf;
#endif
-/* Simulate __has_attribute on compilers that lack it. It is used only
- on arguments like alloc_size that are handled in this simulation.
- __has_attribute should be used only in #if expressions, as Oracle
+/* A substitute for __has_attribute on compilers that lack it.
+ It is used only on arguments like cleanup that are handled here.
+ This macro should be used only in #if expressions, as Oracle
Studio 12.5's __has_attribute does not work in plain code. */
-#ifndef __has_attribute
-# define __has_attribute(a) __has_attribute_##a
-# define __has_attribute_alloc_size GNUC_PREREQ (4, 3, 0)
-# define __has_attribute_cleanup GNUC_PREREQ (3, 4, 0)
-# define __has_attribute_cold GNUC_PREREQ (4, 3, 0)
-# define __has_attribute_externally_visible GNUC_PREREQ (4, 1, 0)
-# define __has_attribute_no_address_safety_analysis false
-# define __has_attribute_no_sanitize_address GNUC_PREREQ (4, 8, 0)
-# define __has_attribute_no_sanitize_undefined GNUC_PREREQ (4, 9, 0)
-# define __has_attribute_returns_nonnull GNUC_PREREQ (4, 9, 0)
-# define __has_attribute_warn_unused_result GNUC_PREREQ (3, 4, 0)
+#ifdef __has_attribute
+# define HAS_ATTRIBUTE(a) __has_attribute (__##a##__)
+#else
+# define HAS_ATTRIBUTE(a) HAS_ATTR_##a
+# define HAS_ATTR_cleanup GNUC_PREREQ (3, 4, 0)
+# define HAS_ATTR_no_address_safety_analysis false
+# define HAS_ATTR_no_sanitize false
+# define HAS_ATTR_no_sanitize_address GNUC_PREREQ (4, 8, 0)
+# define HAS_ATTR_no_sanitize_undefined GNUC_PREREQ (4, 9, 0)
#endif
-/* Simulate __has_feature on compilers that lack it. It is used only
+/* A substitute for __has_feature on compilers that lack it. It is used only
to define ADDRESS_SANITIZER below. */
-#ifndef __has_feature
-# define __has_feature(a) false
+#ifdef __has_feature
+# define HAS_FEATURE(a) __has_feature (a)
+#else
+# define HAS_FEATURE(a) false
#endif
/* True if addresses are being sanitized. */
-#if defined __SANITIZE_ADDRESS__ || __has_feature (address_sanitizer)
+#if defined __SANITIZE_ADDRESS__ || HAS_FEATURE (address_sanitizer)
# define ADDRESS_SANITIZER true
#else
# define ADDRESS_SANITIZER false
@@ -226,37 +228,8 @@ extern void _DebPrint (const char *fmt, ...);
extern char *emacs_getenv_TZ (void);
extern int emacs_setenv_TZ (char const *);
-/* Avoid __attribute__ ((cold)) on MinGW; see thread starting at
- <https://lists.gnu.org/r/emacs-devel/2019-04/msg01152.html>. */
-#if __has_attribute (cold) && !defined __MINGW32__
-# define ATTRIBUTE_COLD __attribute__ ((cold))
-#else
-# define ATTRIBUTE_COLD
-#endif
-
-#if __GNUC__ >= 3 /* On GCC 3.0 we might get a warning. */
-#define NO_INLINE __attribute__((noinline))
-#else
-#define NO_INLINE
-#endif
-
-#if __has_attribute (externally_visible)
-#define EXTERNALLY_VISIBLE __attribute__((externally_visible))
-#else
-#define EXTERNALLY_VISIBLE
-#endif
-
-#if GNUC_PREREQ (2, 7, 0)
-# define ATTRIBUTE_FORMAT(spec) __attribute__ ((__format__ spec))
-#else
-# define ATTRIBUTE_FORMAT(spec) /* empty */
-#endif
-
-#if GNUC_PREREQ (7, 0, 0)
-# define FALLTHROUGH __attribute__ ((__fallthrough__))
-#else
-# define FALLTHROUGH ((void) 0)
-#endif
+#define NO_INLINE ATTRIBUTE_NOINLINE
+#define EXTERNALLY_VISIBLE ATTRIBUTE_EXTERNALLY_VISIBLE
#if GNUC_PREREQ (4, 4, 0) && defined __GLIBC_MINOR__
# define PRINTF_ARCHETYPE __gnu_printf__
@@ -288,16 +261,8 @@ extern int emacs_setenv_TZ (char const *);
#define ATTRIBUTE_FORMAT_PRINTF(string_index, first_to_check) \
ATTRIBUTE_FORMAT ((PRINTF_ARCHETYPE, string_index, first_to_check))
-#define ARG_NONNULL _GL_ARG_NONNULL
-#define ATTRIBUTE_CONST _GL_ATTRIBUTE_CONST
-#define ATTRIBUTE_PURE _GL_ATTRIBUTE_PURE
-#define ATTRIBUTE_UNUSED _GL_UNUSED
-
-#if GNUC_PREREQ (3, 3, 0) && !defined __ICC
-# define ATTRIBUTE_MAY_ALIAS __attribute__ ((__may_alias__))
-#else
-# define ATTRIBUTE_MAY_ALIAS
-#endif
+#define ARG_NONNULL ATTRIBUTE_NONNULL
+#define ATTRIBUTE_UNUSED MAYBE_UNUSED
/* Declare NAME to be a pointer to an object of type TYPE, initialized
to the address ADDR, which may be of a different type. Accesses
@@ -308,27 +273,13 @@ extern int emacs_setenv_TZ (char const *);
type ATTRIBUTE_MAY_ALIAS *name = (type *) (addr)
#if 3 <= __GNUC__
-# define ATTRIBUTE_MALLOC __attribute__ ((__malloc__))
# define ATTRIBUTE_SECTION(name) __attribute__((section (name)))
#else
-# define ATTRIBUTE_MALLOC
#define ATTRIBUTE_SECTION(name)
#endif
-#if __has_attribute (alloc_size)
-# define ATTRIBUTE_ALLOC_SIZE(args) __attribute__ ((__alloc_size__ args))
-#else
-# define ATTRIBUTE_ALLOC_SIZE(args)
-#endif
-
#define ATTRIBUTE_MALLOC_SIZE(args) ATTRIBUTE_MALLOC ATTRIBUTE_ALLOC_SIZE
(args)
-#if __has_attribute (returns_nonnull)
-# define ATTRIBUTE_RETURNS_NONNULL __attribute__ ((returns_nonnull))
-#else
-# define ATTRIBUTE_RETURNS_NONNULL
-#endif
-
/* Work around GCC bug 59600: when a function is inlined, the inlined
code may have its addresses sanitized even if the function has the
no_sanitize_address attribute. This bug is fixed in GCC 4.9.0 and
@@ -344,10 +295,10 @@ extern int emacs_setenv_TZ (char const *);
/* Attribute of functions whose code should not have addresses
sanitized. */
-#if __has_attribute (no_sanitize_address)
+#if HAS_ATTRIBUTE (no_sanitize_address)
# define ATTRIBUTE_NO_SANITIZE_ADDRESS \
__attribute__ ((no_sanitize_address)) ADDRESS_SANITIZER_WORKAROUND
-#elif __has_attribute (no_address_safety_analysis)
+#elif HAS_ATTRIBUTE (no_address_safety_analysis)
# define ATTRIBUTE_NO_SANITIZE_ADDRESS \
__attribute__ ((no_address_safety_analysis)) ADDRESS_SANITIZER_WORKAROUND
#else
@@ -356,9 +307,9 @@ extern int emacs_setenv_TZ (char const *);
/* Attribute of functions whose undefined behavior should not be sanitized. */
-#if __has_attribute (no_sanitize_undefined)
+#if HAS_ATTRIBUTE (no_sanitize_undefined)
# define ATTRIBUTE_NO_SANITIZE_UNDEFINED __attribute__
((no_sanitize_undefined))
-#elif __has_attribute (no_sanitize)
+#elif HAS_ATTRIBUTE (no_sanitize)
# define ATTRIBUTE_NO_SANITIZE_UNDEFINED \
__attribute__ ((no_sanitize ("undefined")))
#else
diff --git a/src/data.c b/src/data.c
index bce2e53..1db0a98 100644
--- a/src/data.c
+++ b/src/data.c
@@ -695,8 +695,14 @@ DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
}
DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
- doc: /* Make SYMBOL's value be void.
-Return SYMBOL. */)
+ doc: /* Empty out the value cell of SYMBOL, making it void as a
variable.
+Return SYMBOL.
+
+If a variable is void, trying to evaluate the variable signals a
+`void-variable' error, instead of returning a value. For more
+details, see Info node `(elisp) Void Variables'.
+
+See also `fmakunbound'. */)
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
@@ -707,8 +713,14 @@ Return SYMBOL. */)
}
DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
- doc: /* Make SYMBOL's function definition be nil.
-Return SYMBOL. */)
+ doc: /* Make SYMBOL's function definition be void.
+Return SYMBOL.
+
+If a function definition is void, trying to call a function by that
+name will cause a `void-function' error. For more details, see Info
+node `(elisp) Function Cells'.
+
+See also `makunbound'. */)
(register Lisp_Object symbol)
{
CHECK_SYMBOL (symbol);
diff --git a/src/dispnew.c b/src/dispnew.c
index 5b6fa51..1ae59e3 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -881,7 +881,7 @@ clear_glyph_row (struct glyph_row *row)
enum { off = offsetof (struct glyph_row, used) };
/* Zero everything except pointers in `glyphs'. */
- memset (row->used, 0, sizeof *row - off);
+ memset ((char *) row + off, 0, sizeof *row - off);
}
diff --git a/src/editfns.c b/src/editfns.c
index c32488e..763d95b 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3019,7 +3019,7 @@ printed representation. The padding, if any, normally
goes on the
left, but it goes on the right if the - flag is present. The padding
character is normally a space, but it is 0 if the 0 flag is present.
The 0 flag is ignored if the - flag is present, or the format sequence
-is something other than %d, %e, %f, and %g.
+is something other than %d, %o, %x, %e, %f, and %g.
For %e and %f sequences, the number after the "." in the precision
specifier says how many decimal places to show; if zero, the decimal
diff --git a/src/emacs-module.c b/src/emacs-module.c
index e43e490..3d1827c 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -248,7 +248,7 @@ module_decode_utf_8 (const char *str, ptrdiff_t len)
of `internal_condition_case' etc., and to avoid worrying about
passing information to the handler functions. */
-#if !__has_attribute (cleanup)
+#if !HAS_ATTRIBUTE (cleanup)
#error "__attribute__ ((cleanup)) not supported by this compiler; try GCC"
#endif
diff --git a/src/emacs-module.h.in b/src/emacs-module.h.in
index cd75c09..6a39d50 100644
--- a/src/emacs-module.h.in
+++ b/src/emacs-module.h.in
@@ -48,10 +48,14 @@ information how to write modules and use this header file.
# define EMACS_NOEXCEPT_TYPEDEF
#endif
-#ifdef __has_attribute
-#if __has_attribute(__nonnull__)
-# define EMACS_ATTRIBUTE_NONNULL(...) __attribute__((__nonnull__(__VA_ARGS__)))
-#endif
+#if 3 < __GNUC__ + (3 <= __GNUC_MINOR__)
+# define EMACS_ATTRIBUTE_NONNULL(...) \
+ __attribute__ ((__nonnull__ (__VA_ARGS__)))
+#elif defined __has_attribute
+# if __has_attribute (__nonnull__)
+# define EMACS_ATTRIBUTE_NONNULL(...) \
+ __attribute__ ((__nonnull__ (__VA_ARGS__)))
+# endif
#endif
#ifndef EMACS_ATTRIBUTE_NONNULL
# define EMACS_ATTRIBUTE_NONNULL(...)
@@ -81,7 +85,7 @@ struct emacs_runtime
/* Return an environment pointer. */
emacs_env *(*get_environment) (struct emacs_runtime *runtime)
- EMACS_ATTRIBUTE_NONNULL(1);
+ EMACS_ATTRIBUTE_NONNULL (1);
};
/* Type aliases for function pointer types used in the module API.
@@ -166,7 +170,7 @@ struct emacs_env_28
/* Every module should define a function as follows. */
extern int emacs_module_init (struct emacs_runtime *runtime)
EMACS_NOEXCEPT
- EMACS_ATTRIBUTE_NONNULL(1);
+ EMACS_ATTRIBUTE_NONNULL (1);
#ifdef __cplusplus
}
diff --git a/src/emacs.c b/src/emacs.c
index ea9c4cd..49793fd 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -124,6 +124,11 @@ static const char emacs_version[] = PACKAGE_VERSION;
static const char emacs_copyright[] = COPYRIGHT;
static const char emacs_bugreport[] = PACKAGE_BUGREPORT;
+/* Put version info into the executable in the form that 'ident' uses. */
+char const EXTERNALLY_VISIBLE RCS_Id[]
+ = "$Id" ": GNU Emacs " PACKAGE_VERSION
+ " (" EMACS_CONFIGURATION " " EMACS_CONFIG_FEATURES ") $";
+
/* Empty lisp strings. To avoid having to build any others. */
Lisp_Object empty_unibyte_string, empty_multibyte_string;
diff --git a/src/eval.c b/src/eval.c
index 4009b4f..5b43b81 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2915,6 +2915,21 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs,
Lisp_Object *args)
}
}
+/* Call the compiled Lisp function FUN. If we have not yet read FUN's
+ bytecode string and constants vector, fetch them from the file first. */
+
+static Lisp_Object
+fetch_and_exec_byte_code (Lisp_Object fun, Lisp_Object syms_left,
+ ptrdiff_t nargs, Lisp_Object *args)
+{
+ if (CONSP (AREF (fun, COMPILED_BYTECODE)))
+ Ffetch_bytecode (fun);
+ return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
+ AREF (fun, COMPILED_CONSTANTS),
+ AREF (fun, COMPILED_STACK_DEPTH),
+ syms_left, nargs, args);
+}
+
static Lisp_Object
apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
{
@@ -2979,9 +2994,6 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
}
else if (COMPILEDP (fun))
{
- ptrdiff_t size = PVSIZE (fun);
- if (size <= COMPILED_STACK_DEPTH)
- xsignal1 (Qinvalid_function, fun);
syms_left = AREF (fun, COMPILED_ARGLIST);
if (FIXNUMP (syms_left))
/* A byte-code object with an integer args template means we
@@ -2993,15 +3005,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
argument-binding code below instead (as do all interpreted
functions, even lexically bound ones). */
{
- /* If we have not actually read the bytecode string
- and constants vector yet, fetch them from the file. */
- if (CONSP (AREF (fun, COMPILED_BYTECODE)))
- Ffetch_bytecode (fun);
- return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
- AREF (fun, COMPILED_CONSTANTS),
- AREF (fun, COMPILED_STACK_DEPTH),
- syms_left,
- nargs, arg_vector);
+ return fetch_and_exec_byte_code (fun, syms_left, nargs, arg_vector);
}
lexenv = Qnil;
}
@@ -3070,16 +3074,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
if (CONSP (fun))
val = Fprogn (XCDR (XCDR (fun)));
else
- {
- /* If we have not actually read the bytecode string
- and constants vector yet, fetch them from the file. */
- if (CONSP (AREF (fun, COMPILED_BYTECODE)))
- Ffetch_bytecode (fun);
- val = exec_byte_code (AREF (fun, COMPILED_BYTECODE),
- AREF (fun, COMPILED_CONSTANTS),
- AREF (fun, COMPILED_STACK_DEPTH),
- Qnil, 0, 0);
- }
+ val = fetch_and_exec_byte_code (fun, Qnil, 0, NULL);
return unbind_to (count, val);
}
@@ -3164,9 +3159,6 @@ lambda_arity (Lisp_Object fun)
}
else if (COMPILEDP (fun))
{
- ptrdiff_t size = PVSIZE (fun);
- if (size <= COMPILED_STACK_DEPTH)
- xsignal1 (Qinvalid_function, fun);
syms_left = AREF (fun, COMPILED_ARGLIST);
if (FIXNUMP (syms_left))
return get_byte_code_arity (syms_left);
@@ -3209,13 +3201,11 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode,
Sfetch_bytecode,
if (COMPILEDP (object))
{
- ptrdiff_t size = PVSIZE (object);
- if (size <= COMPILED_STACK_DEPTH)
- xsignal1 (Qinvalid_function, object);
if (CONSP (AREF (object, COMPILED_BYTECODE)))
{
tem = read_doc_string (AREF (object, COMPILED_BYTECODE));
- if (!CONSP (tem))
+ if (! (CONSP (tem) && STRINGP (XCAR (tem))
+ && VECTORP (XCDR (tem))))
{
tem = AREF (object, COMPILED_BYTECODE);
if (CONSP (tem) && STRINGP (XCAR (tem)))
@@ -3223,7 +3213,19 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode,
Sfetch_bytecode,
else
error ("Invalid byte code");
}
- ASET (object, COMPILED_BYTECODE, XCAR (tem));
+
+ Lisp_Object bytecode = XCAR (tem);
+ if (STRING_MULTIBYTE (bytecode))
+ {
+ /* BYTECODE must have been produced by Emacs 20.2 or earlier
+ because it produced a raw 8-bit string for byte-code and now
+ such a byte-code string is loaded as multibyte with raw 8-bit
+ characters converted to multibyte form. Convert them back to
+ the original unibyte form. */
+ bytecode = Fstring_as_unibyte (bytecode);
+ }
+
+ ASET (object, COMPILED_BYTECODE, bytecode);
ASET (object, COMPILED_CONSTANTS, XCDR (tem));
}
}
diff --git a/src/fns.c b/src/fns.c
index ec0004d..b2f84b2 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1593,16 +1593,16 @@ The value is actually the tail of LIST whose car is
ELT. */)
}
DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
- doc: /* Return non-nil if KEY is `eq' to the car of an element of LIST.
-The value is actually the first element of LIST whose car is KEY.
-Elements of LIST that are not conses are ignored. */)
- (Lisp_Object key, Lisp_Object list)
+ doc: /* Return non-nil if KEY is `eq' to the car of an element of ALIST.
+The value is actually the first element of ALIST whose car is KEY.
+Elements of ALIST that are not conses are ignored. */)
+ (Lisp_Object key, Lisp_Object alist)
{
- Lisp_Object tail = list;
+ Lisp_Object tail = alist;
FOR_EACH_TAIL (tail)
if (CONSP (XCAR (tail)) && EQ (XCAR (XCAR (tail)), key))
return XCAR (tail);
- CHECK_LIST_END (tail, list);
+ CHECK_LIST_END (tail, alist);
return Qnil;
}
@@ -1610,22 +1610,22 @@ Elements of LIST that are not conses are ignored. */)
Use only on objects known to be non-circular lists. */
Lisp_Object
-assq_no_quit (Lisp_Object key, Lisp_Object list)
+assq_no_quit (Lisp_Object key, Lisp_Object alist)
{
- for (; ! NILP (list); list = XCDR (list))
- if (CONSP (XCAR (list)) && EQ (XCAR (XCAR (list)), key))
- return XCAR (list);
+ for (; ! NILP (alist); alist = XCDR (alist))
+ if (CONSP (XCAR (alist)) && EQ (XCAR (XCAR (alist)), key))
+ return XCAR (alist);
return Qnil;
}
DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0,
- doc: /* Return non-nil if KEY is equal to the car of an element of LIST.
-The value is actually the first element of LIST whose car equals KEY.
+ doc: /* Return non-nil if KEY is equal to the car of an element of
ALIST.
+The value is actually the first element of ALIST whose car equals KEY.
Equality is defined by TESTFN if non-nil or by `equal' if nil. */)
- (Lisp_Object key, Lisp_Object list, Lisp_Object testfn)
+ (Lisp_Object key, Lisp_Object alist, Lisp_Object testfn)
{
- Lisp_Object tail = list;
+ Lisp_Object tail = alist;
FOR_EACH_TAIL (tail)
{
Lisp_Object car = XCAR (tail);
@@ -1636,7 +1636,7 @@ Equality is defined by TESTFN if non-nil or by `equal' if
nil. */)
: !NILP (call2 (testfn, XCAR (car), key))))
return car;
}
- CHECK_LIST_END (tail, list);
+ CHECK_LIST_END (tail, alist);
return Qnil;
}
@@ -1645,11 +1645,11 @@ Equality is defined by TESTFN if non-nil or by `equal'
if nil. */)
that are not too deep and are not window configurations. */
Lisp_Object
-assoc_no_quit (Lisp_Object key, Lisp_Object list)
+assoc_no_quit (Lisp_Object key, Lisp_Object alist)
{
- for (; ! NILP (list); list = XCDR (list))
+ for (; ! NILP (alist); alist = XCDR (alist))
{
- Lisp_Object car = XCAR (list);
+ Lisp_Object car = XCAR (alist);
if (CONSP (car)
&& (EQ (XCAR (car), key) || equal_no_quit (XCAR (car), key)))
return car;
@@ -1658,24 +1658,24 @@ assoc_no_quit (Lisp_Object key, Lisp_Object list)
}
DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
- doc: /* Return non-nil if KEY is `eq' to the cdr of an element of LIST.
-The value is actually the first element of LIST whose cdr is KEY. */)
- (Lisp_Object key, Lisp_Object list)
+ doc: /* Return non-nil if KEY is `eq' to the cdr of an element of ALIST.
+The value is actually the first element of ALIST whose cdr is KEY. */)
+ (Lisp_Object key, Lisp_Object alist)
{
- Lisp_Object tail = list;
+ Lisp_Object tail = alist;
FOR_EACH_TAIL (tail)
if (CONSP (XCAR (tail)) && EQ (XCDR (XCAR (tail)), key))
return XCAR (tail);
- CHECK_LIST_END (tail, list);
+ CHECK_LIST_END (tail, alist);
return Qnil;
}
DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0,
- doc: /* Return non-nil if KEY is `equal' to the cdr of an element of
LIST.
-The value is actually the first element of LIST whose cdr equals KEY. */)
- (Lisp_Object key, Lisp_Object list)
+ doc: /* Return non-nil if KEY is `equal' to the cdr of an element of
ALIST.
+The value is actually the first element of ALIST whose cdr equals KEY. */)
+ (Lisp_Object key, Lisp_Object alist)
{
- Lisp_Object tail = list;
+ Lisp_Object tail = alist;
FOR_EACH_TAIL (tail)
{
Lisp_Object car = XCAR (tail);
@@ -1683,7 +1683,7 @@ The value is actually the first element of LIST whose cdr
equals KEY. */)
&& (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key))))
return car;
}
- CHECK_LIST_END (tail, list);
+ CHECK_LIST_END (tail, alist);
return Qnil;
}
@@ -2508,26 +2508,36 @@ ARRAY is a vector, string, char-table, or bool-vector.
*/)
}
else if (STRINGP (array))
{
- register unsigned char *p = SDATA (array);
- int charval;
+ unsigned char *p = SDATA (array);
CHECK_CHARACTER (item);
- charval = XFIXNAT (item);
+ int charval = XFIXNAT (item);
size = SCHARS (array);
- if (STRING_MULTIBYTE (array))
+ if (size != 0)
{
+ CHECK_IMPURE (array, XSTRING (array));
unsigned char str[MAX_MULTIBYTE_LENGTH];
- int len = CHAR_STRING (charval, str);
- ptrdiff_t size_byte = SBYTES (array);
- ptrdiff_t product;
+ int len;
+ if (STRING_MULTIBYTE (array))
+ len = CHAR_STRING (charval, str);
+ else
+ {
+ str[0] = charval;
+ len = 1;
+ }
- if (INT_MULTIPLY_WRAPV (size, len, &product) || product != size_byte)
- error ("Attempt to change byte length of a string");
- for (idx = 0; idx < size_byte; idx++)
- *p++ = str[idx % len];
+ ptrdiff_t size_byte = SBYTES (array);
+ if (len == 1 && size == size_byte)
+ memset (p, str[0], size);
+ else
+ {
+ ptrdiff_t product;
+ if (INT_MULTIPLY_WRAPV (size, len, &product)
+ || product != size_byte)
+ error ("Attempt to change byte length of a string");
+ for (idx = 0; idx < size_byte; idx++)
+ *p++ = str[idx % len];
+ }
}
- else
- for (idx = 0; idx < size; idx++)
- p[idx] = charval;
}
else if (BOOL_VECTOR_P (array))
return bool_vector_fill (array, item);
@@ -2542,12 +2552,15 @@ DEFUN ("clear-string", Fclear_string, Sclear_string,
This makes STRING unibyte and may change its length. */)
(Lisp_Object string)
{
- ptrdiff_t len;
CHECK_STRING (string);
- len = SBYTES (string);
- memset (SDATA (string), 0, len);
- STRING_SET_CHARS (string, len);
- STRING_SET_UNIBYTE (string);
+ ptrdiff_t len = SBYTES (string);
+ if (len != 0 || STRING_MULTIBYTE (string))
+ {
+ CHECK_IMPURE (string, XSTRING (string));
+ memset (SDATA (string), 0, len);
+ STRING_SET_CHARS (string, len);
+ STRING_SET_UNIBYTE (string);
+ }
return Qnil;
}
@@ -4392,7 +4405,7 @@ hash_clear (struct Lisp_Hash_Table *h)
{
ptrdiff_t size = HASH_TABLE_SIZE (h);
if (!hash_rehash_needed_p (h))
- memclear (XVECTOR (h->hash)->contents, size * word_size);
+ memclear (xvector_contents (h->hash), size * word_size);
for (ptrdiff_t i = 0; i < size; i++)
{
set_hash_next_slot (h, i, i < size - 1 ? i + 1 : -1);
diff --git a/src/gtkutil.c b/src/gtkutil.c
index 681f86f..5d1ce6d 100644
--- a/src/gtkutil.c
+++ b/src/gtkutil.c
@@ -1404,10 +1404,15 @@ xg_free_frame_widgets (struct frame *f)
FRAME_X_WINDOW (f) = 0; /* Set to avoid XDestroyWindow in xterm.c */
FRAME_X_RAW_DRAWABLE (f) = 0;
FRAME_GTK_OUTER_WIDGET (f) = 0;
+ if (x->ttip_widget)
+ {
+ /* Remove ttip_lbl from ttip_widget's custom slot before
+ destroying it, to avoid double-free (Bug#41239). */
+ gtk_tooltip_set_custom (x->ttip_widget, NULL);
+ g_object_unref (G_OBJECT (x->ttip_widget));
+ }
if (x->ttip_lbl)
gtk_widget_destroy (x->ttip_lbl);
- if (x->ttip_widget)
- g_object_unref (G_OBJECT (x->ttip_widget));
}
}
diff --git a/src/intervals.c b/src/intervals.c
index d4a734c..0257591 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -117,10 +117,11 @@ create_root_interval (Lisp_Object parent)
/* Make the interval TARGET have exactly the properties of SOURCE. */
void
-copy_properties (register INTERVAL source, register INTERVAL target)
+copy_properties (INTERVAL source, INTERVAL target)
{
if (DEFAULT_INTERVAL_P (source) && DEFAULT_INTERVAL_P (target))
return;
+ eassume (source && target);
COPY_INTERVAL_CACHE (source, target);
set_interval_plist (target, Fcopy_sequence (source->plist));
diff --git a/src/keyboard.c b/src/keyboard.c
index c94d794..f9b9399 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -8302,7 +8302,7 @@ append_tab_bar_item (void)
/* Append entries from tab_bar_item_properties to the end of
tab_bar_items_vector. */
vcopy (tab_bar_items_vector, ntab_bar_items,
- XVECTOR (tab_bar_item_properties)->contents, TAB_BAR_ITEM_NSLOTS);
+ xvector_contents (tab_bar_item_properties), TAB_BAR_ITEM_NSLOTS);
ntab_bar_items += TAB_BAR_ITEM_NSLOTS;
}
@@ -8779,7 +8779,7 @@ append_tool_bar_item (void)
/* Append entries from tool_bar_item_properties to the end of
tool_bar_items_vector. */
vcopy (tool_bar_items_vector, ntool_bar_items,
- XVECTOR (tool_bar_item_properties)->contents, TOOL_BAR_ITEM_NSLOTS);
+ xvector_contents (tool_bar_item_properties), TOOL_BAR_ITEM_NSLOTS);
ntool_bar_items += TOOL_BAR_ITEM_NSLOTS;
}
diff --git a/src/lisp.h b/src/lisp.h
index 4c8b4e0..b601d77 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -277,7 +277,8 @@ error !;
allocation in a containing union that has GCALIGNED_UNION_MEMBER)
and does not contain a GC-aligned struct or union, putting
GCALIGNED_STRUCT after its closing '}' can help the compiler
- generate better code.
+ generate better code. Also, such structs should be added to the
+ emacs_align_type union in alloc.c.
Although these macros are reasonably portable, they are not
guaranteed on non-GCC platforms, as C11 does not require support
@@ -1341,7 +1342,6 @@ dead_object (void)
#define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
#define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
#define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
-#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
#define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
#define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
#define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
@@ -2801,8 +2801,10 @@ struct Lisp_Float
{
double data;
struct Lisp_Float *chain;
+ GCALIGNED_UNION_MEMBER
} u;
- } GCALIGNED_STRUCT;
+ };
+verify (GCALIGNED (struct Lisp_Float));
INLINE bool
(FLOATP) (Lisp_Object x)
@@ -3354,6 +3356,27 @@ struct frame;
#define HAVE_EXT_TOOL_BAR true
#endif
+/* Return the address of vector A's element at index I. */
+
+INLINE Lisp_Object *
+xvector_contents_addr (Lisp_Object a, ptrdiff_t i)
+{
+ /* This should return &XVECTOR (a)->contents[i], but that would run
+ afoul of GCC bug 95072. */
+ void *v = XVECTOR (a);
+ char *p = v;
+ void *w = p + header_size + i * word_size;
+ return w;
+}
+
+/* Return the address of vector A's elements. */
+
+INLINE Lisp_Object *
+xvector_contents (Lisp_Object a)
+{
+ return xvector_contents_addr (a, 0);
+}
+
/* Copy COUNT Lisp_Objects from ARGS to contents of V starting from OFFSET. */
INLINE void
@@ -3361,7 +3384,7 @@ vcopy (Lisp_Object v, ptrdiff_t offset, Lisp_Object const
*args,
ptrdiff_t count)
{
eassert (0 <= offset && 0 <= count && offset + count <= ASIZE (v));
- memcpy (XVECTOR (v)->contents + offset, args, count * sizeof *args);
+ memcpy (xvector_contents_addr (v, offset), args, count * sizeof *args);
}
/* Functions to modify hash tables. */
@@ -3794,7 +3817,15 @@ extern void alloc_unexec_pre (void);
extern void alloc_unexec_post (void);
extern void mark_maybe_objects (Lisp_Object const *, ptrdiff_t);
extern void mark_stack (char const *, char const *);
-extern void flush_stack_call_func (void (*func) (void *arg), void *arg);
+extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg);
+
+INLINE void
+flush_stack_call_func (void (*func) (void *arg), void *arg)
+{
+ __builtin_unwind_init ();
+ flush_stack_call_func1 (func, arg);
+}
+
extern void garbage_collect (void);
extern void maybe_garbage_collect (void);
extern const char *pending_malloc_warning;
@@ -3909,7 +3940,6 @@ build_string (const char *str)
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object);
-extern void make_byte_code (struct Lisp_Vector *);
extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t);
diff --git a/src/lread.c b/src/lread.c
index 59bf529..53b4e1b 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -2966,8 +2966,26 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
struct Lisp_Vector *vec;
tmp = read_vector (readcharfun, 1);
vec = XVECTOR (tmp);
- if (vec->header.size == 0)
- invalid_syntax ("Empty byte-code object");
+ if (! (COMPILED_STACK_DEPTH < vec->header.size
+ && (FIXNUMP (vec->contents[COMPILED_ARGLIST])
+ || CONSP (vec->contents[COMPILED_ARGLIST])
+ || NILP (vec->contents[COMPILED_ARGLIST]))
+ && ((STRINGP (vec->contents[COMPILED_BYTECODE])
+ && VECTORP (vec->contents[COMPILED_CONSTANTS]))
+ || CONSP (vec->contents[COMPILED_BYTECODE]))
+ && FIXNATP (vec->contents[COMPILED_STACK_DEPTH])))
+ invalid_syntax ("Invalid byte-code object");
+
+ if (STRING_MULTIBYTE (AREF (tmp, COMPILED_BYTECODE)))
+ {
+ /* BYTESTR must have been produced by Emacs 20.2 or earlier
+ because it produced a raw 8-bit string for byte-code and
+ now such a byte-code string is loaded as multibyte with
+ raw 8-bit characters converted to multibyte form.
+ Convert them back to the original unibyte form. */
+ ASET (tmp, COMPILED_BYTECODE,
+ Fstring_as_unibyte (AREF (tmp, COMPILED_BYTECODE)));
+ }
if (COMPILED_DOC_STRING < vec->header.size
&& EQ (AREF (tmp, COMPILED_DOC_STRING), make_fixnum (0)))
@@ -2986,7 +3004,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool
first_in_list)
ASET (tmp, COMPILED_DOC_STRING, make_ufixnum (hash));
}
- make_byte_code (vec);
+ XSETPVECTYPE (vec, PVEC_COMPILED);
return tmp;
}
if (c == '(')
@@ -3824,8 +3842,6 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag)
{
Lisp_Object tem = read_list (1, readcharfun);
ptrdiff_t size = list_length (tem);
- if (bytecodeflag && size <= COMPILED_STACK_DEPTH)
- error ("Invalid byte code");
Lisp_Object vector = make_nil_vector (size);
Lisp_Object *ptr = XVECTOR (vector)->contents;
diff --git a/src/nsterm.m b/src/nsterm.m
index a8f7540..1953138 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -7335,48 +7335,39 @@ not_in_argv (NSString *arg)
- (void)viewDidResize:(NSNotification *)notification
{
NSRect frame = [self frame];
- int oldw, oldh, neww, newh;
+ int neww, newh;
if (! FRAME_LIVE_P (emacsframe))
return;
+ NSTRACE ("[EmacsView viewDidResize]");
+
+ neww = (int)NSWidth (frame);
+ newh = (int)NSHeight (frame);
+ NSTRACE_SIZE ("New size", NSMakeSize (neww, newh));
+
#ifdef NS_DRAW_TO_BUFFER
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
if ([self wantsUpdateLayer])
{
-#endif
CGFloat scale = [[self window] backingScaleFactor];
- oldw = (CGFloat)CGBitmapContextGetWidth (drawingBuffer) / scale;
- oldh = (CGFloat)CGBitmapContextGetHeight (drawingBuffer) / scale;
-#if MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
- else
- {
-#endif
-#endif /* NS_DRAW_TO_BUFFER */
-#if !defined (NS_DRAW_TO_BUFFER) || MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- oldw = FRAME_PIXEL_WIDTH (emacsframe);
- oldh = FRAME_PIXEL_HEIGHT (emacsframe);
-#endif
-#if defined (NS_DRAW_TO_BUFFER) && MAC_OS_X_VERSION_MIN_REQUIRED < 101400
- }
-#endif
-
- neww = (int)NSWidth (frame);
- newh = (int)NSHeight (frame);
+ int oldw = (CGFloat)CGBitmapContextGetWidth (drawingBuffer) / scale;
+ int oldh = (CGFloat)CGBitmapContextGetHeight (drawingBuffer) / scale;
- NSTRACE ("[EmacsView viewDidResize]");
+ NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh));
- /* Don't want to do anything when the view size hasn't changed. */
- if ((oldh == newh && oldw == neww))
- {
- NSTRACE_MSG ("No change");
- return;
+ /* Don't want to do anything when the view size hasn't changed. */
+ if ((oldh == newh && oldw == neww))
+ {
+ NSTRACE_MSG ("No change");
+ return;
+ }
}
+#endif
- NSTRACE_SIZE ("Original size", NSMakeSize (oldw, oldh));
- NSTRACE_SIZE ("New size", NSMakeSize (neww, newh));
-
+ /* I'm not sure if it's safe to call this every time the view
+ changes size, as Emacs may already know about the change.
+ Unfortunately there doesn't seem to be a bullet-proof method of
+ determining whether we need to call it or not. */
change_frame_size (emacsframe,
FRAME_PIXEL_TO_TEXT_WIDTH (emacsframe, neww),
FRAME_PIXEL_TO_TEXT_HEIGHT (emacsframe, newh),
diff --git a/src/search.c b/src/search.c
index 567270a..ec076c1 100644
--- a/src/search.c
+++ b/src/search.c
@@ -353,8 +353,8 @@ data if you want to preserve them. */)
}
DEFUN ("posix-looking-at", Fposix_looking_at, Sposix_looking_at, 1, 1, 0,
- doc: /* Return t if text after point matches regular expression REGEXP.
-Find the longest match, in accord with Posix regular expression rules.
+ doc: /* Return t if text after point matches REGEXP according to Posix
rules.
+Find the longest match, in accordance with Posix regular expression rules.
This function modifies the match data that `match-beginning',
`match-end' and `match-data' access; save and restore the match
data if you want to preserve them. */)
@@ -449,7 +449,7 @@ matched by the parenthesis constructions in REGEXP. */)
}
DEFUN ("posix-string-match", Fposix_string_match, Sposix_string_match, 2, 3, 0,
- doc: /* Return index of start of first match for REGEXP in STRING, or
nil.
+ doc: /* Return index of start of first match for Posix REGEXP in
STRING, or nil.
Find the longest match, in accord with Posix regular expression rules.
Case is ignored if `case-fold-search' is non-nil in the current buffer.
If third arg START is non-nil, start search at that index in STRING.
@@ -2276,7 +2276,7 @@ and `replace-match'. */)
DEFUN ("posix-search-backward", Fposix_search_backward,
Sposix_search_backward, 1, 4,
"sPosix search backward: ",
- doc: /* Search backward from point for match for regular expression
REGEXP.
+ doc: /* Search backward from point for match for REGEXP according to
Posix rules.
Find the longest match in accord with Posix regular expression rules.
Set point to the beginning of the occurrence found, and return point.
An optional second argument bounds the search; it is a buffer position.
@@ -2304,7 +2304,7 @@ and `replace-match'. */)
DEFUN ("posix-search-forward", Fposix_search_forward, Sposix_search_forward,
1, 4,
"sPosix search: ",
- doc: /* Search forward from point for regular expression REGEXP.
+ doc: /* Search forward from point for REGEXP according to Posix rules.
Find the longest match in accord with Posix regular expression rules.
Set point to the end of the occurrence found, and return point.
An optional second argument bounds the search; it is a buffer position.
diff --git a/src/systhread.h b/src/systhread.h
index 005388f..73c764a 100644
--- a/src/systhread.h
+++ b/src/systhread.h
@@ -21,12 +21,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <stdbool.h>
-#if __has_attribute (warn_unused_result)
-# define ATTRIBUTE_WARN_UNUSED_RESULT __attribute__ ((warn_unused_result))
-#else
-# define ATTRIBUTE_WARN_UNUSED_RESULT
-#endif
-
#ifdef THREADS_ENABLED
#ifdef HAVE_PTHREAD
@@ -108,13 +102,13 @@ extern void sys_cond_broadcast (sys_cond_t *);
extern void sys_cond_destroy (sys_cond_t *);
extern sys_thread_t sys_thread_self (void)
- ATTRIBUTE_WARN_UNUSED_RESULT;
+ NODISCARD;
extern bool sys_thread_equal (sys_thread_t, sys_thread_t)
- ATTRIBUTE_WARN_UNUSED_RESULT;
+ NODISCARD;
extern bool sys_thread_create (sys_thread_t *, thread_creation_function *,
void *)
- ATTRIBUTE_WARN_UNUSED_RESULT;
+ NODISCARD;
extern void sys_thread_yield (void);
extern void sys_thread_set_name (const char *);
diff --git a/src/term.c b/src/term.c
index a3aef31..94bf013 100644
--- a/src/term.c
+++ b/src/term.c
@@ -563,8 +563,8 @@ encode_terminal_code (struct glyph *src, int src_len,
{
cmp = composition_table[src->u.cmp.id];
required = cmp->glyph_len;
- required *= MAX_MULTIBYTE_LENGTH;
}
+ required *= MAX_MULTIBYTE_LENGTH;
if (encode_terminal_src_size - nbytes < required)
{
diff --git a/src/textprop.c b/src/textprop.c
index 960dba3..0876bad 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -766,14 +766,13 @@ the current buffer), POSITION is a buffer position
(integer or marker).
If OBJECT is a string, POSITION is a 0-based index into it.
In a string, scan runs to the end of the string, unless LIMIT is non-nil.
-In a buffer, if LIMIT is nil or omitted, it runs to (point-max), and the
-value cannot exceed that.
+In a buffer, scan runs to end of buffer, unless LIMIT is non-nil.
If the optional fourth argument LIMIT is non-nil, don't search
past position LIMIT; return LIMIT if nothing is found before LIMIT.
+However, if OBJECT is a buffer and LIMIT is beyond the end of the
+buffer, this function returns `point-max', not LIMIT.
-The property values are compared with `eq'.
-If the property is constant all the way to the end of OBJECT, return the
-last valid position in OBJECT. */)
+The property values are compared with `eq'. */)
(Lisp_Object position, Lisp_Object prop, Lisp_Object object, Lisp_Object
limit)
{
if (STRINGP (object))
@@ -832,6 +831,9 @@ last valid position in OBJECT. */)
value = Fget_char_property (position, prop, object);
if (!EQ (value, initial_value))
break;
+
+ if (XFIXNAT (position) >= ZV)
+ break;
}
position = unbind_to (count, position);
diff --git a/src/thread.c b/src/thread.c
index df1a705..b638dd7 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -717,12 +717,17 @@ run_thread (void *state)
{
/* Make sure stack_top and m_stack_bottom are properly aligned as GC
expects. */
- max_align_t stack_pos;
+ union
+ {
+ Lisp_Object o;
+ void *p;
+ char c;
+ } stack_pos;
struct thread_state *self = state;
struct thread_state **iter;
- self->m_stack_bottom = self->stack_top = (char *) &stack_pos;
+ self->m_stack_bottom = self->stack_top = &stack_pos.c;
self->thread_id = sys_thread_self ();
if (self->thread_name)
diff --git a/src/w32.c b/src/w32.c
index 0f69e65..f391f5e 100644
--- a/src/w32.c
+++ b/src/w32.c
@@ -6519,7 +6519,15 @@ acl_get_file (const char *fname, acl_type_t type)
if (!get_file_security (fname, si, psd, sd_len, &sd_len))
{
xfree (psd);
- errno = EIO;
+ err = GetLastError ();
+ if (err == ERROR_NOT_SUPPORTED)
+ errno = ENOTSUP;
+ else if (err == ERROR_FILE_NOT_FOUND
+ || err == ERROR_PATH_NOT_FOUND
+ || err == ERROR_INVALID_NAME)
+ errno = ENOENT;
+ else
+ errno = EIO;
psd = NULL;
}
}
@@ -6530,6 +6538,8 @@ acl_get_file (const char *fname, acl_type_t type)
be encoded in the current ANSI codepage. */
|| err == ERROR_INVALID_NAME)
errno = ENOENT;
+ else if (err == ERROR_NOT_SUPPORTED)
+ errno = ENOTSUP;
else
errno = EIO;
}
diff --git a/src/xdisp.c b/src/xdisp.c
index 140d134..cf15f57 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -5120,7 +5120,7 @@ handle_display_spec (struct it *it, Lisp_Object spec,
Lisp_Object object,
if (CONSP (spec) && EQ (XCAR (spec), Qdisable_eval))
{
enable_eval = false;
- spec = XCAR (XCDR (spec));
+ spec = CONSP (XCDR (spec)) ? XCAR (XCDR (spec)) : Qnil;
}
if (CONSP (spec)
@@ -10486,7 +10486,7 @@ include the height of both, if present, in the return
value. */)
struct buffer *b;
struct it it;
struct buffer *old_b = NULL;
- ptrdiff_t start, end, pos;
+ ptrdiff_t start, end, bpos;
struct text_pos startp;
void *itdata = NULL;
int c, max_x = 0, max_y = 0, x = 0, y = 0;
@@ -10501,29 +10501,55 @@ include the height of both, if present, in the return
value. */)
}
if (NILP (from))
- start = BEGV;
+ {
+ start = BEGV;
+ bpos = BEGV_BYTE;
+ }
else if (EQ (from, Qt))
{
- start = pos = BEGV;
- while ((pos++ < ZV) && (c = FETCH_CHAR (pos))
- && (c == ' ' || c == '\t' || c == '\n' || c == '\r'))
- start = pos;
- while ((pos-- > BEGV) && (c = FETCH_CHAR (pos)) && (c == ' ' || c ==
'\t'))
- start = pos;
+ start = BEGV;
+ bpos = BEGV_BYTE;
+ while (bpos < ZV_BYTE)
+ {
+ c = fetch_char_advance (&start, &bpos);
+ if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
+ break;
+ }
+ while (bpos > BEGV_BYTE)
+ {
+ dec_both (&start, &bpos);
+ c = FETCH_CHAR (bpos);
+ if (!(c == ' ' || c == '\t'))
+ break;
+ }
}
else
- start = clip_to_bounds (BEGV, fix_position (from), ZV);
+ {
+ start = clip_to_bounds (BEGV, fix_position (from), ZV);
+ bpos = CHAR_TO_BYTE (start);
+ }
+
+ SET_TEXT_POS (startp, start, bpos);
if (NILP (to))
end = ZV;
else if (EQ (to, Qt))
{
- end = pos = ZV;
- while ((pos-- > BEGV) && (c = FETCH_CHAR (pos))
- && (c == ' ' || c == '\t' || c == '\n' || c == '\r'))
- end = pos;
- while ((pos++ < ZV) && (c = FETCH_CHAR (pos)) && (c == ' ' || c == '\t'))
- end = pos;
+ end = ZV;
+ bpos = ZV_BYTE;
+ while (bpos > BEGV_BYTE)
+ {
+ dec_both (&end, &bpos);
+ c = FETCH_CHAR (bpos);
+ if (!(c == ' ' || c == '\t' || c == '\n' || c == '\r'))
+ break;
+ }
+ while (bpos < ZV_BYTE)
+ {
+ c = fetch_char_advance (&end, &bpos);
+ if (!(c == ' ' || c == '\t'))
+ break;
+ }
}
else
end = clip_to_bounds (start, fix_position (to), ZV);
@@ -10537,7 +10563,6 @@ include the height of both, if present, in the return
value. */)
max_y = XFIXNUM (y_limit);
itdata = bidi_shelve_cache ();
- SET_TEXT_POS (startp, start, CHAR_TO_BYTE (start));
start_display (&it, w, startp);
/* It makes no sense to measure dimensions of region of text that
crosses the point where bidi reordering changes scan direction.
@@ -34965,7 +34990,8 @@ It has no effect when set to 0, or when line numbers
are not absolute. */);
Fmake_variable_buffer_local (Qdisplay_line_numbers_offset);
DEFVAR_BOOL ("display-fill-column-indicator", Vdisplay_fill_column_indicator,
- doc: /* Non-nil means display the fill column indicator. */);
+ doc: /* Non-nil means display the fill column indicator.
+See Info node `Displaying Boundaries' for details. */);
Vdisplay_fill_column_indicator = false;
DEFSYM (Qdisplay_fill_column_indicator, "display-fill-column-indicator");
Fmake_variable_buffer_local (Qdisplay_fill_column_indicator);
@@ -34974,7 +35000,8 @@ It has no effect when set to 0, or when line numbers
are not absolute. */);
doc: /* Column for indicator when `display-fill-column-indicator' is
non-nil.
The default value is t which means that the indicator
will use the `fill-column' variable. If it is set to an integer the
-indicator will be drawn in that column. */);
+indicator will be drawn in that column.
+See Info node `Displaying Boundaries' for details. */);
Vdisplay_fill_column_indicator_column = Qt;
DEFSYM (Qdisplay_fill_column_indicator_column,
"display-fill-column-indicator-column");
Fmake_variable_buffer_local (Qdisplay_fill_column_indicator_column);
@@ -34982,7 +35009,8 @@ indicator will be drawn in that column. */);
DEFVAR_LISP ("display-fill-column-indicator-character",
Vdisplay_fill_column_indicator_character,
doc: /* Character to draw the indicator when
`display-fill-column-indicator' is non-nil.
The default is U+2502 but a good alternative is (ascii 124)
-if the font in fill-column-indicator face does not support Unicode characters.
*/);
+if the font in fill-column-indicator face does not support Unicode characters.
+See Info node `Displaying Boundaries' for details. */);
Vdisplay_fill_column_indicator_character = Qnil;
DEFSYM (Qdisplay_fill_column_indicator_character,
"display-fill-column-indicator-character");
Fmake_variable_buffer_local (Qdisplay_fill_column_indicator_character);
diff --git a/src/xfaces.c b/src/xfaces.c
index bab142a..7d7aff9 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -1888,7 +1888,7 @@ get_lface_attributes_no_remap (struct frame *f,
Lisp_Object face_name,
lface = lface_from_face_name_no_resolve (f, face_name, signal_p);
if (! NILP (lface))
- memcpy (attrs, XVECTOR (lface)->contents,
+ memcpy (attrs, xvector_contents (lface),
LFACE_VECTOR_SIZE * sizeof *attrs);
return !NILP (lface);
@@ -2860,7 +2860,7 @@ The value is TO. */)
f = XFRAME (new_frame);
}
- vcopy (copy, 0, XVECTOR (lface)->contents, LFACE_VECTOR_SIZE);
+ vcopy (copy, 0, xvector_contents (lface), LFACE_VECTOR_SIZE);
/* Changing a named face means that all realized faces depending on
that face are invalid. Since we cannot tell which realized faces
@@ -5598,7 +5598,7 @@ realize_default_face (struct frame *f)
/* Realize the face; it must be fully-specified now. */
eassert (lface_fully_specified_p (XVECTOR (lface)->contents));
check_lface (lface);
- memcpy (attrs, XVECTOR (lface)->contents, sizeof attrs);
+ memcpy (attrs, xvector_contents (lface), sizeof attrs);
struct face *face = realize_face (c, attrs, DEFAULT_FACE_ID);
#ifndef HAVE_WINDOW_SYSTEM
diff --git a/src/xfns.c b/src/xfns.c
index 1f381e2..2ab5080 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -6738,9 +6738,11 @@ x_hide_tip (bool delete)
}
}
- /* Reset tip_last_frame, it will be reassigned when showing the
- next GTK+ system tooltip. */
- tip_last_frame = Qnil;
+ /* When using GTK+ system tooltips (compare Bug#41200) reset
+ tip_last_frame. It will be reassigned when showing the next
+ GTK+ system tooltip. */
+ if (x_gtk_use_system_tooltips)
+ tip_last_frame = Qnil;
/* Now look whether there's an Emacs tip around. */
if (FRAMEP (tip_frame))
diff --git a/src/xmenu.c b/src/xmenu.c
index 9201a28..dba7e88 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -763,7 +763,7 @@ set_frame_menubar (struct frame *f, bool first_time, bool
deep_p)
/* Save the frame's previous menu bar contents data. */
if (previous_menu_items_used)
- memcpy (previous_items, XVECTOR (f->menu_bar_vector)->contents,
+ memcpy (previous_items, xvector_contents (f->menu_bar_vector),
previous_menu_items_used * word_size);
/* Fill in menu_items with the current menu bar contents.
diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el
index df658b9..22ca7e2 100644
--- a/test/lisp/arc-mode-tests.el
+++ b/test/lisp/arc-mode-tests.el
@@ -28,7 +28,7 @@
(let ((alist (list (cons 448 "-rwx------")
(cons 420 "-rw-r--r--")
(cons 292 "-r--r--r--")
- (cons 512 "----------")
+ (cons 512 "---------T")
(cons 1024 "------S---") ; Bug#28092
(cons 2048 "---S------"))))
(dolist (x alist)
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index 6db5426..c8cb97a 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -345,6 +345,58 @@ An existing calc stack is reused, otherwise a new one is
created."
(should (Math-num-integerp '(float 1 0)))
(should-not (Math-num-integerp nil)))
+(ert-deftest calc-matrix-determinant ()
+ (should (equal (calcFunc-det '(vec (vec 3)))
+ 3))
+ (should (equal (calcFunc-det '(vec (vec 2 3) (vec 6 7)))
+ -4))
+ (should (equal (calcFunc-det '(vec (vec 1 2 3) (vec 4 5 7) (vec 9 6 2)))
+ 15))
+ (should (equal (calcFunc-det '(vec (vec 0 5 7 3)
+ (vec 0 0 2 0)
+ (vec 1 2 3 4)
+ (vec 0 0 0 3)))
+ 30))
+ (should (equal (calcFunc-det '(vec (vec (var a var-a))))
+ '(var a var-a)))
+ (should (equal (calcFunc-det '(vec (vec 2 (var a var-a))
+ (vec 7 (var a var-a))))
+ '(* -5 (var a var-a))))
+ (should (equal (calcFunc-det '(vec (vec 1 0 0 0)
+ (vec 0 1 0 0)
+ (vec 0 0 0 1)
+ (vec 0 0 (var a var-a) 0)))
+ '(neg (var a var-a)))))
+
+(ert-deftest calc-gcd ()
+ (should (equal (calcFunc-gcd 3 4) 1))
+ (should (equal (calcFunc-gcd 12 15) 3))
+ (should (equal (calcFunc-gcd -12 15) 3))
+ (should (equal (calcFunc-gcd 12 -15) 3))
+ (should (equal (calcFunc-gcd -12 -15) 3))
+ (should (equal (calcFunc-gcd 0 5) 5))
+ (should (equal (calcFunc-gcd 5 0) 5))
+ (should (equal (calcFunc-gcd 0 -5) 5))
+ (should (equal (calcFunc-gcd -5 0) 5))
+ (should (equal (calcFunc-gcd 0 0) 0))
+ (should (equal (calcFunc-gcd 0 '(var x var-x))
+ '(calcFunc-abs (var x var-x))))
+ (should (equal (calcFunc-gcd '(var x var-x) 0)
+ '(calcFunc-abs (var x var-x)))))
+
+(ert-deftest calc-sum-gcd ()
+ ;; sum(gcd(0,n),n,-1,-1)
+ (should (equal (math-simplify '(calcFunc-sum (calcFunc-gcd 0 (var n var-n))
+ (var n var-n) -1 -1))
+ 1))
+ ;; sum(sum(gcd(n,k),k,-1,1),n,-1,1)
+ (should (equal (math-simplify
+ '(calcFunc-sum
+ (calcFunc-sum (calcFunc-gcd (var n var-n) (var k var-k))
+ (var k var-k) -1 1)
+ (var n var-n) -1 1))
+ 8)))
+
(provide 'calc-tests)
;;; calc-tests.el ends here
diff --git a/test/lisp/calendar/cal-julian-tests.el
b/test/lisp/calendar/cal-julian-tests.el
new file mode 100644
index 0000000..76118b3
--- /dev/null
+++ b/test/lisp/calendar/cal-julian-tests.el
@@ -0,0 +1,72 @@
+;;; cal-julian-tests.el --- tests for calendar/cal-julian.el -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'cal-julian)
+
+(ert-deftest cal-julian-test-to-absolute ()
+ (should (equal (calendar-gregorian-from-absolute
+ (calendar-julian-to-absolute
+ '(10 25 1917)))
+ '(11 7 1917))))
+
+(ert-deftest cal-julian-test-from-absolute ()
+ (should (equal (calendar-julian-from-absolute
+ (calendar-absolute-from-gregorian
+ '(11 7 1917)))
+ '(10 25 1917))))
+
+(ert-deftest cal-julian-test-date-string ()
+ (should (equal (let ((calendar-date-display-form
calendar-iso-date-display-form))
+ (calendar-julian-date-string '(11 7 1917)))
+ "1917-10-25")))
+
+(defmacro with-cal-julian-test (&rest body)
+ `(save-window-excursion
+ (unwind-protect
+ (progn
+ (calendar)
+ ,@body)
+ (kill-buffer "*Calendar*"))))
+
+(ert-deftest cal-julian-test-goto-date ()
+ (with-cal-julian-test
+ (calendar-julian-goto-date '(10 25 1917))
+ (should (looking-at "7"))))
+
+(ert-deftest cal-julian-test-astro-to-and-from-absolute ()
+ (should (= (+ (calendar-astro-to-absolute 0.0)
+ (calendar-astro-from-absolute 0.0))
+ 0.0)))
+
+(ert-deftest cal-julian-calendar-astro-date-string ()
+ (should (equal (calendar-astro-date-string '(10 25 1917)) "2421527")))
+
+(ert-deftest calendar-astro-goto-day-number ()
+ (with-cal-julian-test
+ (calendar-astro-goto-day-number 2421527)
+ (backward-char)
+ (should (looking-at "25"))))
+
+(provide 'cal-julian-tests)
+;;; cal-julian-tests.el ends here
diff --git a/test/lisp/calendar/icalendar-tests.el
b/test/lisp/calendar/icalendar-tests.el
index 9862552..d496878 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -1,4 +1,4 @@
-;; icalendar-tests.el --- Test suite for icalendar.el
+;; icalendar-tests.el --- Test suite for icalendar.el -*- lexical-binding:t
-*-
;; Copyright (C) 2005, 2008-2020 Free Software Foundation, Inc.
@@ -419,11 +419,11 @@ END:VEVENT
")))
(should (string= "SUM sum DES des LOC loc ORG org"
(icalendar--format-ical-event event)))
- (setq icalendar-import-format (lambda (&rest ignore)
+ (setq icalendar-import-format (lambda (&rest _ignore)
"helloworld"))
(should (string= "helloworld" (icalendar--format-ical-event event)))
(setq icalendar-import-format
- (lambda (e)
+ (lambda (event)
(format "-%s-%s-%s-%s-%s-%s-%s-"
(icalendar--get-event-property event 'SUMMARY)
(icalendar--get-event-property event 'DESCRIPTION)
@@ -465,8 +465,7 @@ END:VEVENT
(ert-deftest icalendar--decode-isodatetime ()
"Test `icalendar--decode-isodatetime'."
- (let ((tz (getenv "TZ"))
- result)
+ (let ((tz (getenv "TZ")))
(unwind-protect
(progn
;; Use Eastern European Time (UTC+2, UTC+3 daylight saving)
@@ -886,7 +885,7 @@ During import test the timezone is set to Central European
Time."
(icalendar-tests--do-test-import input expected-american)))))
(setenv "TZ" timezone))))
-(defun icalendar-tests--do-test-import (input expected-output)
+(defun icalendar-tests--do-test-import (_input expected-output)
"Actually perform import test.
Argument INPUT input icalendar string.
Argument EXPECTED-OUTPUT expected diary string."
@@ -2347,7 +2346,7 @@ END:VCALENDAR
(let ((time (icalendar--decode-isodatetime string day zone)))
(format-time-string "%FT%T%z" (encode-time time) 0)))
-(defun icalendar-tests--decode-isodatetime (ical-string)
+(defun icalendar-tests--decode-isodatetime (_ical-string)
(should (equal (icalendar-test--format "20040917T050910-0200")
"2004-09-17T03:09:10+0000"))
(should (equal (icalendar-test--format "20040917T050910")
diff --git a/test/lisp/calendar/iso8601-tests.el
b/test/lisp/calendar/iso8601-tests.el
index e8b155a..c835f57 100644
--- a/test/lisp/calendar/iso8601-tests.el
+++ b/test/lisp/calendar/iso8601-tests.el
@@ -232,6 +232,37 @@
(should (equal (iso8601-parse-time "15:27:46-05")
'(46 27 15 nil nil nil nil nil -18000))))
+
+(defun test-iso8601-format-time-string-zone-round-trip (offset-minutes
z-format)
+ "Pass OFFSET-MINUTES to format-time-string with Z-FORMAT, a %z variation,
+and then to iso8601-parse-zone. The result should be the original offset."
+ (let* ((offset-seconds (* 60 offset-minutes))
+ (zone-string (format-time-string z-format 0 offset-seconds))
+ (offset-rt
+ (condition-case nil
+ (iso8601-parse-zone zone-string)
+ (wrong-type-argument (format "(failed to parse %S)" zone-string))))
+ ;; compare strings that contain enough info to debug failures
+ (success (format "%s(%s) -> %S -> %s"
+ z-format offset-minutes zone-string offset-minutes))
+ (actual (format "%s(%s) -> %S -> %s"
+ z-format offset-minutes zone-string offset-rt)))
+ (should (equal success actual))))
+
+(ert-deftest iso8601-format-time-string-zone-round-trip ()
+ "Round trip zone offsets through format-time-string and iso8601-parse-zone.
+Passing a time zone created by format-time-string %z to
+iso8601-parse-zone should yield the original offset."
+ (dolist (offset-minutes
+ (list
+ ;; compare hours (1- and 2-digit), minutes, both, neither
+ (* 5 60) (* 11 60) 5 11 (+ (* 5 60) 30) (+ (* 11 60) 30) 0
+ ;; do negative values, too
+ (* -5 60) (* -11 60) -5 -11 (- (* -5 60) 30) (- (* -11 60) 30)))
+ (dolist (z-format '("%z" "%:z" "%:::z"))
+ (test-iso8601-format-time-string-zone-round-trip
+ offset-minutes z-format))))
+
(ert-deftest standard-test-date-and-time-of-day ()
(should (equal (iso8601-parse "19850412T101530")
'(30 15 10 12 4 1985 nil -1 nil)))
diff --git a/test/lisp/calendar/parse-time-tests.el
b/test/lisp/calendar/parse-time-tests.el
index 4924e8b..e1801a5 100644
--- a/test/lisp/calendar/parse-time-tests.el
+++ b/test/lisp/calendar/parse-time-tests.el
@@ -1,4 +1,4 @@
-;; parse-time-tests.el --- Test suite for parse-time.el
+;; parse-time-tests.el --- Test suite for parse-time.el -*- lexical-binding:t
-*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/cedet/semantic-utest-fmt.el
b/test/lisp/cedet/semantic-utest-fmt.el
index 2fc2b68..c2f2bb7 100644
--- a/test/lisp/cedet/semantic-utest-fmt.el
+++ b/test/lisp/cedet/semantic-utest-fmt.el
@@ -1,4 +1,4 @@
-;;; cedet/semantic-utest-fmt.el --- Parsing / Formatting tests
+;;; cedet/semantic-utest-fmt.el --- Parsing / Formatting tests -*-
lexical-binding:t -*-
;;; Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
@@ -69,7 +69,6 @@ Files to visit are in `semantic-fmt-utest-file-list'."
;; Run the tests.
(let ((fb (find-buffer-visiting fname))
(b (semantic-find-file-noselect fname))
- (num 0)
(tags nil))
(save-current-buffer
@@ -82,7 +81,6 @@ Files to visit are in `semantic-fmt-utest-file-list'."
(semantic-clear-toplevel-cache)
;; Force the reparse
(setq tags (semantic-fetch-tags))
- (setq num (length tags))
(save-excursion
(while tags
diff --git a/test/lisp/cedet/semantic-utest-ia.el
b/test/lisp/cedet/semantic-utest-ia.el
index 5761224..c99ef97 100644
--- a/test/lisp/cedet/semantic-utest-ia.el
+++ b/test/lisp/cedet/semantic-utest-ia.el
@@ -1,4 +1,4 @@
-;;; semantic-utest-ia.el --- Analyzer unit tests
+;;; semantic-utest-ia.el --- Analyzer unit tests -*- lexical-binding:t -*-
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
@@ -211,7 +211,7 @@
;; completions, then remove the below debug-on-error setting.
(debug-on-error nil)
(acomp
- (condition-case err
+ (condition-case _err
(semantic-analyze-possible-completions ctxt)
((error user-error) nil))
))
@@ -438,11 +438,10 @@ tag that contains point, and return that."
(let* ((ctxt (semantic-analyze-current-context))
(target (car (reverse (oref ctxt prefix))))
(tag (semantic-current-tag))
- (start (current-time))
(Lcount 0))
(when (semantic-tag-p target)
(semantic-symref-hits-in-region
- target (lambda (start end prefix) (setq Lcount (1+ Lcount)))
+ target (lambda (_start _end _prefix) (setq Lcount (1+ Lcount)))
(semantic-tag-start tag)
(semantic-tag-end tag))
Lcount)))
diff --git a/test/lisp/cedet/semantic-utest.el
b/test/lisp/cedet/semantic-utest.el
index 7e33655..e537871 100644
--- a/test/lisp/cedet/semantic-utest.el
+++ b/test/lisp/cedet/semantic-utest.el
@@ -1,4 +1,4 @@
-;;; semantic-utest.el --- Tests for semantic's parsing system.
+;;; semantic-utest.el --- Tests for semantic's parsing system. -*-
lexical-binding:t -*-
;;; Copyright (C) 2003-2004, 2007-2020 Free Software Foundation, Inc.
@@ -537,10 +537,9 @@ Pre-fill the buffer with CONTENTS."
-(defun semantic-utest-generic (testname filename contents name-contents
names-removed killme insertme)
+(defun semantic-utest-generic (filename contents name-contents names-removed
killme insertme)
"Generic unit test according to template.
Should work for languages without .h files, python javascript java.
-TESTNAME is the name of the test.
FILENAME is the name of the file to create.
CONTENTS is the contents of the file to test.
NAME-CONTENTS is the list of names that should be in the contents.
@@ -564,10 +563,8 @@ INSERTME is the text to be inserted after the deletion."
(sit-for 0)
;; Run the tests.
- ;;(message "First parsing test %s." testname)
(should (semantic-utest-verify-names name-contents))
- ;;(message "Invalid tag test %s." testname)
(semantic-utest-last-invalid name-contents names-removed killme insertme)
(should (semantic-utest-verify-names name-contents))
@@ -576,16 +573,17 @@ INSERTME is the text to be inserted after the deletion."
(kill-buffer buff)
)))
+(defvar python-indent-guess-indent-offset) ; Silence byte-compiler.
(ert-deftest semantic-utest-Python()
- (skip-unless (featurep 'python-mode))
+ (skip-unless (fboundp 'python-mode))
(let ((python-indent-guess-indent-offset nil))
- (semantic-utest-generic "Python" (semantic-utest-fname "pytest.py")
semantic-utest-Python-buffer-contents semantic-utest-Python-name-contents
'("fun2") "#1" "#deleted line")
+ (semantic-utest-generic (semantic-utest-fname "pytest.py")
semantic-utest-Python-buffer-contents semantic-utest-Python-name-contents
'("fun2") "#1" "#deleted line")
))
(ert-deftest semantic-utest-Javascript()
(if (fboundp 'javascript-mode)
- (semantic-utest-generic "Javascript" (semantic-utest-fname
"javascripttest.js") semantic-utest-Javascript-buffer-contents
semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line")
+ (semantic-utest-generic (semantic-utest-fname "javascripttest.js")
semantic-utest-Javascript-buffer-contents
semantic-utest-Javascript-name-contents '("fun2") "//1" "//deleted line")
(message "Skipping JavaScript test: NO major mode."))
)
@@ -593,34 +591,34 @@ INSERTME is the text to be inserted after the deletion."
;; If JDE is installed, it might mess things up depending on the version
;; that was installed.
(let ((auto-mode-alist '(("\\.java\\'" . java-mode))))
- (semantic-utest-generic "Java" (semantic-utest-fname "JavaTest.java")
semantic-utest-Java-buffer-contents semantic-utest-Java-name-contents
'("fun2") "//1" "//deleted line")
+ (semantic-utest-generic (semantic-utest-fname "JavaTest.java")
semantic-utest-Java-buffer-contents semantic-utest-Java-name-contents
'("fun2") "//1" "//deleted line")
))
(ert-deftest semantic-utest-Makefile()
- (semantic-utest-generic "Makefile" (semantic-utest-fname "Makefile")
semantic-utest-Makefile-buffer-contents semantic-utest-Makefile-name-contents
'("fun2") "#1" "#deleted line")
+ (semantic-utest-generic (semantic-utest-fname "Makefile")
semantic-utest-Makefile-buffer-contents semantic-utest-Makefile-name-contents
'("fun2") "#1" "#deleted line")
)
(ert-deftest semantic-utest-Scheme()
(skip-unless nil) ;; There is a bug w/ scheme parser. Skip this for now.
- (semantic-utest-generic "Scheme" (semantic-utest-fname "tst.scm")
semantic-utest-Scheme-buffer-contents semantic-utest-Scheme-name-contents
'("fun2") ";1" ";deleted line")
+ (semantic-utest-generic (semantic-utest-fname "tst.scm")
semantic-utest-Scheme-buffer-contents semantic-utest-Scheme-name-contents
'("fun2") ";1" ";deleted line")
)
-
+(defvar html-helper-build-new-buffer) ; Silence byte-compiler.
(ert-deftest semantic-utest-Html()
;; Disable html-helper auto-fill-in mode.
- (let ((html-helper-build-new-buffer nil))
- (semantic-utest-generic "HTML" (semantic-utest-fname "tst.html")
semantic-utest-Html-buffer-contents semantic-utest-Html-name-contents
'("fun2") "<!--1-->" "<!--deleted line-->")
+ (let ((html-helper-build-new-buffer nil)) ; FIXME: Why is this bound?
+ (semantic-utest-generic (semantic-utest-fname "tst.html")
semantic-utest-Html-buffer-contents semantic-utest-Html-name-contents
'("fun2") "<!--1-->" "<!--deleted line-->")
))
(ert-deftest semantic-utest-PHP()
(skip-unless (featurep 'php-mode))
- (semantic-utest-generic "PHP" (semantic-utest-fname "phptest.php")
semantic-utest-PHP-buffer-contents semantic-utest-PHP-name-contents '("fun1")
"fun2" "%^@")
+ (semantic-utest-generic (semantic-utest-fname "phptest.php")
semantic-utest-PHP-buffer-contents semantic-utest-PHP-name-contents '("fun1")
"fun2" "%^@")
)
;look at http://mfgames.com/linux/csharp-mode
(ert-deftest semantic-utest-Csharp() ;; hmm i don't even know how to edit a
scharp file. need a csharp mode implementation i suppose
(skip-unless (featurep 'csharp-mode))
- (semantic-utest-generic "C#" (semantic-utest-fname "csharptest.cs")
semantic-utest-Csharp-buffer-contents semantic-utest-Csharp-name-contents
'("fun2") "//1" "//deleted line")
+ (semantic-utest-generic (semantic-utest-fname "csharptest.cs")
semantic-utest-Csharp-buffer-contents semantic-utest-Csharp-name-contents
'("fun2") "//1" "//deleted line")
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -758,7 +756,7 @@ JAVE this thing would need to be recursive to handle java
and csharp"
(sit-for 0)
)
-(defun semantic-utest-last-invalid (name-contents names-removed killme
insertme)
+(defun semantic-utest-last-invalid (_name-contents _names-removed killme
insertme)
"Make the last fcn invalid."
(semantic-utest-kill-indicator killme insertme)
; (semantic-utest-verify-names name-contents names-removed); verify its gone
;new validator doesn't handle skipnames yet
diff --git a/test/lisp/cedet/srecode-utest-getset.el
b/test/lisp/cedet/srecode-utest-getset.el
index e49a195..3419b18 100644
--- a/test/lisp/cedet/srecode-utest-getset.el
+++ b/test/lisp/cedet/srecode-utest-getset.el
@@ -1,4 +1,4 @@
-;;; srecode/test-getset.el --- Test the getset inserter.
+;;; srecode/test-getset.el --- Test the getset inserter. -*- lexical-binding:t
-*-
;; Copyright (C) 2008, 2009, 2011, 2019-2020 Free Software Foundation, Inc
@@ -52,6 +52,7 @@ private:
temporary-file-directory)
"File used to do testing.")
+(defvar srecode-insert-getset-fully-automatic-flag) ; Silence byte-compiler.
(ert-deftest srecode-utest-getset-output ()
"Test various template insertion options."
(save-excursion
diff --git a/test/lisp/cedet/srecode-utest-template.el
b/test/lisp/cedet/srecode-utest-template.el
index 4dd64e2..63c33a3 100644
--- a/test/lisp/cedet/srecode-utest-template.el
+++ b/test/lisp/cedet/srecode-utest-template.el
@@ -1,4 +1,4 @@
-;;; srecode/test.el --- SRecode Core Template tests.
+;;; srecode/test.el --- SRecode Core Template tests. -*- lexical-binding:t -*-
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/comint-tests.el b/test/lisp/comint-tests.el
index 9c27a92..132fe87 100644
--- a/test/lisp/comint-tests.el
+++ b/test/lisp/comint-tests.el
@@ -1,4 +1,4 @@
-;;; comint-testsuite.el
+;;; comint-tests.el -*- lexical-binding:t -*-
;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/custom-resources/custom--test-theme.el
b/test/lisp/custom-resources/custom--test-theme.el
index da9121e..4ced98a 100644
--- a/test/lisp/custom-resources/custom--test-theme.el
+++ b/test/lisp/custom-resources/custom--test-theme.el
@@ -1,3 +1,5 @@
+;;; custom--test-theme.el -- A test theme. -*- lexical-binding:t -*-
+
(deftheme custom--test
"A test theme.")
diff --git a/test/lisp/dabbrev-tests.el b/test/lisp/dabbrev-tests.el
index 0a2f67e..06c5c06 100644
--- a/test/lisp/dabbrev-tests.el
+++ b/test/lisp/dabbrev-tests.el
@@ -1,4 +1,4 @@
-;;; dabbrev-tests.el --- Test suite for dabbrev.
+;;; dabbrev-tests.el --- Test suite for dabbrev. -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/dom-tests.el b/test/lisp/dom-tests.el
index d44851e..f743df7 100644
--- a/test/lisp/dom-tests.el
+++ b/test/lisp/dom-tests.el
@@ -84,6 +84,13 @@
(dom-set-attribute dom attr value)
(should (equal (dom-attr dom attr) value))))
+(ert-deftest dom-tests-remove-attribute ()
+ (let ((dom (copy-tree '(body ((foo . "bar") (zot . "foobar"))))))
+ (should (equal (dom-attr dom 'foo) "bar"))
+ (dom-remove-attribute dom 'foo)
+ (should (equal (dom-attr dom 'foo) nil))
+ (should (equal dom '(body ((zot . "foobar")))))))
+
(ert-deftest dom-tests-attr ()
(let ((dom (dom-tests--tree)))
(should-not (dom-attr dom 'id))
diff --git a/test/lisp/electric-tests.el b/test/lisp/electric-tests.el
index 56d1bdb..67f474c 100644
--- a/test/lisp/electric-tests.el
+++ b/test/lisp/electric-tests.el
@@ -547,6 +547,24 @@ baz\"\""
(should (equal "" (buffer-string))))))
+;;; Undoing
+(ert-deftest electric-pair-undo-unrelated-state ()
+ "Make sure `electric-pair-mode' does not confuse `undo' (bug#39680)."
+ (with-temp-buffer
+ (buffer-enable-undo)
+ (electric-pair-local-mode)
+ (let ((last-command-event ?\())
+ (ert-simulate-command '(self-insert-command 1)))
+ (undo-boundary)
+ (let ((last-command-event ?a))
+ (ert-simulate-command '(self-insert-command 1)))
+ (undo-boundary)
+ (ert-simulate-command '(undo))
+ (let ((last-command-event ?\())
+ (ert-simulate-command '(self-insert-command 1)))
+ (should (string= (buffer-string) "(())"))))
+
+
;;; Electric newlines between pairs
;;; TODO: better tests
(ert-deftest electric-pair-open-extra-newline ()
diff --git a/test/lisp/emacs-lisp/bindat-tests.el
b/test/lisp/emacs-lisp/bindat-tests.el
index f8efa79..14f95a8 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -96,4 +96,20 @@
(dest-ip .
[192 168 1 100]))))))
+(ert-deftest bindat-test-format-vector ()
+ (should (equal (bindat-format-vector [1 2 3] "%d" "x" 2) "1x2"))
+ (should (equal (bindat-format-vector [1 2 3] "%d" "x") "1x2x3")))
+
+(ert-deftest bindat-test-vector-to-dec ()
+ (should (equal (bindat-vector-to-dec [1 2 3]) "1.2.3"))
+ (should (equal (bindat-vector-to-dec [2048 1024 512] ".") "2048.1024.512")))
+
+(ert-deftest bindat-test-vector-to-hex ()
+ (should (equal (bindat-vector-to-hex [1 2 3]) "01:02:03"))
+ (should (equal (bindat-vector-to-hex [2048 1024 512] ".") "800.400.200")))
+
+(ert-deftest bindat-test-ip-to-string ()
+ (should (equal (bindat-ip-to-string [192 168 0 1]) "192.168.0.1"))
+ (should (equal (bindat-ip-to-string "\300\250\0\1") "192.168.0.1")))
+
;;; bindat-tests.el ends here
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el
b/test/lisp/emacs-lisp/bytecomp-tests.el
index d4ceb47..bfe2d06 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1,4 +1,4 @@
-;;; bytecomp-tests.el
+;;; bytecomp-tests.el -*- lexical-binding:t -*-
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/check-declare-tests.el
b/test/lisp/emacs-lisp/check-declare-tests.el
new file mode 100644
index 0000000..bb95421
--- /dev/null
+++ b/test/lisp/emacs-lisp/check-declare-tests.el
@@ -0,0 +1,116 @@
+;;; check-declare-tests.el --- Tests for check-declare.el -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'check-declare)
+(require 'ert)
+(eval-when-compile (require 'subr-x))
+
+(ert-deftest check-declare-tests-locate ()
+ (should (file-exists-p (check-declare-locate "check-declare" "")))
+ (should
+ (string-prefix-p "ext:" (check-declare-locate "ext:foo" ""))))
+
+(ert-deftest check-declare-tests-scan ()
+ (let ((file (make-temp-file "check-declare-tests-")))
+ (unwind-protect
+ (progn
+ (with-temp-file file
+ (insert
+ (string-join
+ '(";; foo comment"
+ "(declare-function ring-insert \"ring\" (ring item))"
+ "(let ((foo 'code)) foo)")
+ "\n")))
+ (let ((res (check-declare-scan file)))
+ (should (= (length res) 1))
+ (pcase-let ((`((,fnfile ,fn ,arglist ,fileonly)) res))
+ (should (string-match-p "ring" fnfile))
+ (should (equal "ring-insert" fn))
+ (should (equal '(ring item) arglist))
+ (should-not fileonly))))
+ (delete-file file))))
+
+(ert-deftest check-declare-tests-verify ()
+ (let ((file (make-temp-file "check-declare-tests-")))
+ (unwind-protect
+ (progn
+ (with-temp-file file
+ (insert
+ (string-join
+ '(";; foo comment"
+ "(defun foo-fun ())"
+ "(defun ring-insert (ring item)"
+ "\"Insert onto ring RING the item ITEM.\""
+ "nil)")
+ "\n")))
+ (should-not
+ (check-declare-verify
+ file '(("foo.el" "ring-insert" (ring item))))))
+ (delete-file file))))
+
+(ert-deftest check-declare-tests-verify-mismatch ()
+ (let ((file (make-temp-file "check-declare-tests-")))
+ (unwind-protect
+ (progn
+ (with-temp-file file
+ (insert
+ (string-join
+ '(";; foo comment"
+ "(defun foo-fun ())"
+ "(defun ring-insert (ring)"
+ "\"Insert onto ring RING the item ITEM.\""
+ "nil)")
+ "\n")))
+ (should
+ (equal
+ (check-declare-verify
+ file '(("foo.el" "ring-insert" (ring item))))
+ '(("foo.el" "ring-insert" "arglist mismatch")))))
+ (delete-file file))))
+
+(ert-deftest check-declare-tests-sort ()
+ (should-not (check-declare-sort '()))
+ (should (equal (check-declare-sort '((a (1 a)) (b (2)) (d (1 d))))
+ '((2 (b)) (1 (a a) (d d))))))
+
+(ert-deftest check-declare-tests-warn ()
+ (with-temp-buffer
+ (let ((check-declare-warning-buffer (buffer-name)))
+ (check-declare-warn
+ "foo-file" "foo-fun" "bar-file" "it wasn't" 999)
+ (let ((res (buffer-string)))
+ ;; Don't care too much about the format of the output, but
+ ;; check that key information is present.
+ (should (string-match-p "foo-file" res))
+ (should (string-match-p "foo-fun" res))
+ (should (string-match-p "bar-file" res))
+ (should (string-match-p "it wasn't" res))
+ (should (string-match-p "999" res))))))
+
+(provide 'check-declare-tests)
+;;; check-declare-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el
b/test/lisp/emacs-lisp/cl-macs-tests.el
index 9ca84f1..24bbad0 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -39,6 +39,15 @@
collect (list c b a))
'((4.0 2 1) (8.3 6 5) (10.4 9 8)))))
+(ert-deftest cl-macs-loop-and-arrays ()
+ "Bug#40727"
+ (should (equal (cl-loop for y = (- (or x 0)) and x across [1 2]
+ collect (cons x y))
+ '((1 . 0) (2 . -1))))
+ (should (equal (cl-loop for x across [1 2] and y = (- (or x 0))
+ collect (cons x y))
+ '((1 . 0) (2 . -1)))))
+
(ert-deftest cl-macs-loop-destructure ()
(should (equal (cl-loop for (a b c) in '((1 2 4.0) (5 6 8.3) (8 9 10.4))
collect (list c b a))
@@ -416,7 +425,9 @@ collection clause."
'(2 3 4 5 6))))
(ert-deftest cl-macs-loop-across-ref ()
- (should (equal (cl-loop with my-vec = ["one" "two" "three"]
+ (should (equal (cl-loop with my-vec = (vector (cl-copy-seq "one")
+ (cl-copy-seq "two")
+ (cl-copy-seq "three"))
for x across-ref my-vec
do (setf (aref x 0) (upcase (aref x 0)))
finally return my-vec)
diff --git a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
index 60e49ab..7be057d 100644
--- a/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
+++ b/test/lisp/emacs-lisp/edebug-resources/edebug-test-code.el
@@ -1,4 +1,4 @@
-;;; edebug-test-code.el --- Sample code for the Edebug test suite
+;;; edebug-test-code.el --- Sample code for the Edebug test suite -*-
lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
index b3e296d..73c3ea8 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-methodinvoke.el
@@ -1,4 +1,4 @@
-;;; eieio-testsinvoke.el -- eieio tests for method invocation
+;;; eieio-testsinvoke.el -- eieio tests for method invocation -*-
lexical-binding:t -*-
;; Copyright (C) 2005, 2008, 2010, 2013-2020 Free Software Foundation,
;; Inc.
@@ -83,36 +83,36 @@
(defclass eitest-B-base2 () ())
(defclass eitest-B (eitest-B-base1 eitest-B-base2) ())
-(defmethod eitest-F :BEFORE ((p eitest-B-base1))
+(defmethod eitest-F :BEFORE ((_p eitest-B-base1))
(eieio-test-method-store :BEFORE 'eitest-B-base1))
-(defmethod eitest-F :BEFORE ((p eitest-B-base2))
+(defmethod eitest-F :BEFORE ((_p eitest-B-base2))
(eieio-test-method-store :BEFORE 'eitest-B-base2))
-(defmethod eitest-F :BEFORE ((p eitest-B))
+(defmethod eitest-F :BEFORE ((_p eitest-B))
(eieio-test-method-store :BEFORE 'eitest-B))
-(defmethod eitest-F ((p eitest-B))
+(defmethod eitest-F ((_p eitest-B))
(eieio-test-method-store :PRIMARY 'eitest-B)
(call-next-method))
-(defmethod eitest-F ((p eitest-B-base1))
+(defmethod eitest-F ((_p eitest-B-base1))
(eieio-test-method-store :PRIMARY 'eitest-B-base1)
(call-next-method))
-(defmethod eitest-F ((p eitest-B-base2))
+(defmethod eitest-F ((_p eitest-B-base2))
(eieio-test-method-store :PRIMARY 'eitest-B-base2)
(when (next-method-p)
(call-next-method))
)
-(defmethod eitest-F :AFTER ((p eitest-B-base1))
+(defmethod eitest-F :AFTER ((_p eitest-B-base1))
(eieio-test-method-store :AFTER 'eitest-B-base1))
-(defmethod eitest-F :AFTER ((p eitest-B-base2))
+(defmethod eitest-F :AFTER ((_p eitest-B-base2))
(eieio-test-method-store :AFTER 'eitest-B-base2))
-(defmethod eitest-F :AFTER ((p eitest-B))
+(defmethod eitest-F :AFTER ((_p eitest-B))
(eieio-test-method-store :AFTER 'eitest-B))
(ert-deftest eieio-test-method-order-list-3 ()
@@ -136,7 +136,7 @@
;;; Test static invocation
;;
-(defmethod eitest-H :STATIC ((class eitest-A))
+(defmethod eitest-H :STATIC ((_class eitest-A))
"No need to do work in here."
'moose)
@@ -147,15 +147,15 @@
;;; Return value from :PRIMARY
;;
-(defmethod eitest-I :BEFORE ((a eitest-A))
+(defmethod eitest-I :BEFORE ((_a eitest-A))
(eieio-test-method-store :BEFORE 'eitest-A)
":before")
-(defmethod eitest-I :PRIMARY ((a eitest-A))
+(defmethod eitest-I :PRIMARY ((_a eitest-A))
(eieio-test-method-store :PRIMARY 'eitest-A)
":primary")
-(defmethod eitest-I :AFTER ((a eitest-A))
+(defmethod eitest-I :AFTER ((_a eitest-A))
(eieio-test-method-store :AFTER 'eitest-A)
":after")
@@ -174,17 +174,17 @@
(defclass C (C-base1 C-base2) ())
;; Just use the obsolete name once, to make sure it also works.
-(defmethod constructor :STATIC ((p C-base1) &rest args)
+(defmethod constructor :STATIC ((_p C-base1) &rest _args)
(eieio-test-method-store :STATIC 'C-base1)
(if (next-method-p) (call-next-method))
)
-(defmethod make-instance :STATIC ((p C-base2) &rest args)
+(defmethod make-instance :STATIC ((_p C-base2) &rest _args)
(eieio-test-method-store :STATIC 'C-base2)
(if (next-method-p) (call-next-method))
)
-(cl-defmethod make-instance ((p (subclass C)) &rest args)
+(cl-defmethod make-instance ((_p (subclass C)) &rest _args)
(eieio-test-method-store :STATIC 'C)
(cl-call-next-method)
)
@@ -213,24 +213,24 @@
(defclass D-base2 (D-base0) () :method-invocation-order :depth-first)
(defclass D (D-base1 D-base2) () :method-invocation-order :depth-first)
-(defmethod eitest-F ((p D))
+(defmethod eitest-F ((_p D))
"D"
(eieio-test-method-store :PRIMARY 'D)
(call-next-method))
-(defmethod eitest-F ((p D-base0))
+(defmethod eitest-F ((_p D-base0))
"D-base0"
(eieio-test-method-store :PRIMARY 'D-base0)
;; This should have no next
;; (when (next-method-p) (call-next-method))
)
-(defmethod eitest-F ((p D-base1))
+(defmethod eitest-F ((_p D-base1))
"D-base1"
(eieio-test-method-store :PRIMARY 'D-base1)
(call-next-method))
-(defmethod eitest-F ((p D-base2))
+(defmethod eitest-F ((_p D-base2))
"D-base2"
(eieio-test-method-store :PRIMARY 'D-base2)
(when (next-method-p)
@@ -256,21 +256,21 @@
(defclass E-base2 (E-base0) () :method-invocation-order :breadth-first)
(defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first)
-(defmethod eitest-F ((p E))
+(defmethod eitest-F ((_p E))
(eieio-test-method-store :PRIMARY 'E)
(call-next-method))
-(defmethod eitest-F ((p E-base0))
+(defmethod eitest-F ((_p E-base0))
(eieio-test-method-store :PRIMARY 'E-base0)
;; This should have no next
;; (when (next-method-p) (call-next-method))
)
-(defmethod eitest-F ((p E-base1))
+(defmethod eitest-F ((_p E-base1))
(eieio-test-method-store :PRIMARY 'E-base1)
(call-next-method))
-(defmethod eitest-F ((p E-base2))
+(defmethod eitest-F ((_p E-base2))
(eieio-test-method-store :PRIMARY 'E-base2)
(when (next-method-p)
(call-next-method))
@@ -293,7 +293,7 @@
(defclass eitest-Ja ()
())
-(defmethod initialize-instance :after ((this eitest-Ja) &rest slots)
+(defmethod initialize-instance :after ((_this eitest-Ja) &rest _slots)
;(message "+Ja")
;; FIXME: Using next-method-p in an after-method is invalid!
(when (next-method-p)
@@ -304,7 +304,7 @@
(defclass eitest-Jb ()
())
-(defmethod initialize-instance :after ((this eitest-Jb) &rest slots)
+(defmethod initialize-instance :after ((_this eitest-Jb) &rest _slots)
;(message "+Jb")
;; FIXME: Using next-method-p in an after-method is invalid!
(when (next-method-p)
@@ -318,7 +318,7 @@
(defclass eitest-Jd (eitest-Jc eitest-Ja)
())
-(defmethod initialize-instance ((this eitest-Jd) &rest slots)
+(defmethod initialize-instance ((_this eitest-Jd) &rest _slots)
;(message "+Jd")
(when (next-method-p)
(call-next-method))
@@ -357,7 +357,7 @@
(call-next-method
this (cons 'CNM-1-1 args))))
-(defmethod CNM-M ((this CNM-1-2) args)
+(defmethod CNM-M ((_this CNM-1-2) args)
(push (cons 'CNM-1-2 (copy-sequence args))
eieio-test-call-next-method-arguments)
(when (next-method-p)
diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
index 3c5aeaf..6979da8 100644
--- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
+++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el
@@ -1,4 +1,4 @@
-;;; eieio-test-persist.el --- Tests for eieio-persistent class
+;;; eieio-test-persist.el --- Tests for eieio-persistent class -*-
lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/ert-x-tests.el
b/test/lisp/emacs-lisp/ert-x-tests.el
index e910329..b760f8c 100644
--- a/test/lisp/emacs-lisp/ert-x-tests.el
+++ b/test/lisp/emacs-lisp/ert-x-tests.el
@@ -1,4 +1,4 @@
-;;; ert-x-tests.el --- Tests for ert-x.el
+;;; ert-x-tests.el --- Tests for ert-x.el -*- lexical-binding:t -*-
;; Copyright (C) 2008, 2010-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
index 3017b52..4bad360 100644
--- a/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-mode.el
@@ -1,4 +1,4 @@
-;;; faceup-test-mode.el --- Dummy major mode for testing `faceup'.
+;;; faceup-test-mode.el --- Dummy major mode for testing `faceup'. -*-
lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
diff --git
a/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
b/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
index ab638ef..d8ab02b 100644
--- a/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
+++ b/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
@@ -1,4 +1,4 @@
-;;; faceup-test-this-file-directory.el --- Support file for faceup tests
+;;; faceup-test-this-file-directory.el --- Support file for faceup tests -*-
lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
index 0838981..3c9ec76 100644
--- a/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
+++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-basics.el
@@ -1,4 +1,4 @@
-;;; faceup-test-basics.el --- Tests for the `faceup' package.
+;;; faceup-test-basics.el --- Tests for the `faceup' package. -*-
lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
b/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
index 4f5fe18..a87c16d 100644
--- a/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
+++ b/test/lisp/emacs-lisp/faceup-tests/faceup-test-files.el
@@ -1,4 +1,4 @@
-;;; faceup-test-files.el --- Self test of `faceup' using dummy major mode.
+;;; faceup-test-files.el --- Self test of `faceup' using dummy major mode.
-*- lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/gnus/gnus-tests.el
b/test/lisp/emacs-lisp/float-sup-tests.el
similarity index 57%
copy from test/lisp/gnus/gnus-tests.el
copy to test/lisp/emacs-lisp/float-sup-tests.el
index d18b3fb..9f9a3da 100644
--- a/test/lisp/gnus/gnus-tests.el
+++ b/test/lisp/emacs-lisp/float-sup-tests.el
@@ -1,8 +1,6 @@
-;;; gnus-tests.el --- Wrapper for the Gnus tests
+;;; float-sup-tests.el --- Tests for float-sup.el -*- lexical-binding:t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
-
-;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Copyright (C) 2020 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -21,13 +19,15 @@
;;; Commentary:
-;; This file should contain nothing but requires for all the Gnus
-;; tests that are not standalone.
-
;;; Code:
-;; registry.el is required by gnus-registry.el but this way we're explicit.
-(require 'registry)
-(require 'gnus-registry)
-(provide 'gnus-tests)
-;;; gnus-tests.el ends here
+(require 'ert)
+
+(ert-deftest float-sup-degrees-and-radians ()
+ (should (equal (degrees-to-radians 180.0) float-pi))
+ (should (equal (radians-to-degrees float-pi) 180.0))
+ (should (equal (radians-to-degrees (degrees-to-radians 360.0)) 360.0))
+ (should (equal (degrees-to-radians (radians-to-degrees float-pi)) float-pi)))
+
+(provide 'float-sup-tests)
+;;; float-sup-tests.el ends here
diff --git a/test/lisp/emacs-lisp/nadvice-tests.el
b/test/lisp/emacs-lisp/nadvice-tests.el
index eabe3cb..a955df0 100644
--- a/test/lisp/emacs-lisp/nadvice-tests.el
+++ b/test/lisp/emacs-lisp/nadvice-tests.el
@@ -1,4 +1,4 @@
-;;; advice-tests.el --- Test suite for the new advice thingy.
+;;; nadvice-tests.el --- Test suite for the new advice thingy. -*-
lexical-binding:t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
diff --git
a/test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el
b/test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el
index 7251622..61c1b04 100644
--- a/test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el
+++ b/test/lisp/emacs-lisp/package-resources/newer-versions/new-pkg-1.0.el
@@ -1,4 +1,4 @@
-;;; new-pkg.el --- A package only seen after "updating" archive-contents
+;;; new-pkg.el --- A package only seen after "updating" archive-contents -*-
lexical-binding:t -*-
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.0
diff --git
a/test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el
b/test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el
index 7b1c00c..301993d 100644
--- a/test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el
+++ b/test/lisp/emacs-lisp/package-resources/newer-versions/simple-single-1.4.el
@@ -1,4 +1,4 @@
-;;; simple-single.el --- A single-file package with no dependencies
+;;; simple-single.el --- A single-file package with no dependencies -*-
lexical-binding:t -*-
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.4
diff --git a/test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el
b/test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el
index b58b658..cb00390 100644
--- a/test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el
+++ b/test/lisp/emacs-lisp/package-resources/simple-depend-1.0.el
@@ -1,4 +1,4 @@
-;;; simple-depend.el --- A single-file package with a dependency.
+;;; simple-depend.el --- A single-file package with a dependency. -*-
lexical-binding:t -*-
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.0
diff --git a/test/lisp/emacs-lisp/package-resources/simple-single-1.3.el
b/test/lisp/emacs-lisp/package-resources/simple-single-1.3.el
index 6756a28..9c3f427 100644
--- a/test/lisp/emacs-lisp/package-resources/simple-single-1.3.el
+++ b/test/lisp/emacs-lisp/package-resources/simple-single-1.3.el
@@ -1,4 +1,4 @@
-;;; simple-single.el --- A single-file package with no dependencies
+;;; simple-single.el --- A single-file package with no dependencies -*-
lexical-binding:t -*-
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.3
diff --git a/test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el
b/test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el
index 9cfe5c0..a0a9607 100644
--- a/test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el
+++ b/test/lisp/emacs-lisp/package-resources/simple-two-depend-1.1.el
@@ -1,4 +1,4 @@
-;;; simple-two-depend.el --- A single-file package with two dependencies.
+;;; simple-two-depend.el --- A single-file package with two dependencies. -*-
lexical-binding:t -*-
;; Author: J. R. Hacker <jrh@example.com>
;; Version: 1.1
diff --git a/test/lisp/emacs-lisp/package-tests.el
b/test/lisp/emacs-lisp/package-tests.el
index 05770d6..732bf5e 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -1,4 +1,4 @@
-;;; package-test.el --- Tests for the Emacs package system
+;;; package-test.el --- Tests for the Emacs package system -*-
lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -143,8 +143,8 @@
,(if basedir `(cd ,basedir))
(unless (file-directory-p package-user-dir)
(mkdir package-user-dir))
- (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest r) t))
- ((symbol-function 'y-or-n-p) (lambda (&rest r) t)))
+ (cl-letf (((symbol-function 'yes-or-no-p) (lambda (&rest _) t))
+ ((symbol-function 'y-or-n-p) (lambda (&rest _) t)))
,@(when install
`((package-initialize)
(package-refresh-contents)
@@ -413,6 +413,21 @@ Must called from within a `tar-mode' buffer."
;; No installed packages in default environment.
(should-error (package-menu-filter-by-status "installed"))))
+(ert-deftest package-test-list-filter-marked ()
+ "Ensure package list is filtered correctly by non-empty mark."
+ (with-package-test ()
+ (let ((buf (package-list-packages)))
+ (revert-buffer)
+ (search-forward-regexp "^ +simple-single")
+ (package-menu-mark-install)
+ (package-menu-filter-marked)
+ (goto-char (point-min))
+ (should (re-search-forward "^I +simple-single" nil t))
+ (should (= (count-lines (point-min) (point-max)) 1))
+ (package-menu-mark-unmark)
+ ;; No marked packages in default environment.
+ (should-error (package-menu-filter-marked)))))
+
(ert-deftest package-test-list-filter-by-version ()
(with-package-menu-test
(should-error (package-menu-filter-by-version "1.1" 'unknown-symbol))) )
@@ -449,7 +464,7 @@ Must called from within a `tar-mode' buffer."
(ert-deftest package-test-update-archives ()
"Test updating package archives."
(with-package-test ()
- (let ((buf (package-list-packages)))
+ (let ((_buf (package-list-packages)))
(revert-buffer)
(search-forward-regexp "^ +simple-single")
(package-menu-mark-install)
@@ -593,6 +608,7 @@ Must called from within a `tar-mode' buffer."
(should (search-forward "This is a bare-bones readme file for the
multi-file"
nil t)))))
+(defvar epg-config--program-alist) ; Silence byte-compiler.
(ert-deftest package-test-signed ()
"Test verifying package signature."
(skip-unless (let ((homedir (make-temp-file "package-test" t)))
@@ -631,7 +647,7 @@ Must called from within a `tar-mode' buffer."
(should (progn (package-install 'signed-good) 'noerror))
(should (progn (package-install 'signed-bad) 'noerror)))
;; Check if the installed package status is updated.
- (let ((buf (package-list-packages)))
+ (let ((_buf (package-list-packages)))
(revert-buffer)
(should (re-search-forward
"^\\s-+signed-good\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-"
diff --git a/test/lisp/emacs-lisp/pcase-tests.el
b/test/lisp/emacs-lisp/pcase-tests.el
index 0b69bd9..ac51241 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -1,4 +1,4 @@
-;;; pcase-tests.el --- Test suite for pcase macro.
+;;; pcase-tests.el --- Test suite for pcase macro. -*- lexical-binding:t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/seq-tests.el
b/test/lisp/emacs-lisp/seq-tests.el
index 77ee4f5..a6a8095 100644
--- a/test/lisp/emacs-lisp/seq-tests.el
+++ b/test/lisp/emacs-lisp/seq-tests.el
@@ -1,4 +1,4 @@
-;;; seq-tests.el --- Tests for sequences.el
+;;; seq-tests.el --- Tests for seq.el -*- lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
@@ -126,7 +126,7 @@ Evaluate BODY for each created sequence.
(with-test-sequences (seq '(6 7 8 9 10))
(should (equal (seq-filter #'test-sequences-evenp seq) '(6 8 10)))
(should (equal (seq-filter #'test-sequences-oddp seq) '(7 9)))
- (should (equal (seq-filter (lambda (elt) nil) seq) '())))
+ (should (equal (seq-filter (lambda (_) nil) seq) '())))
(with-test-sequences (seq '())
(should (equal (seq-filter #'test-sequences-evenp seq) '()))))
@@ -134,7 +134,7 @@ Evaluate BODY for each created sequence.
(with-test-sequences (seq '(6 7 8 9 10))
(should (equal (seq-remove #'test-sequences-evenp seq) '(7 9)))
(should (equal (seq-remove #'test-sequences-oddp seq) '(6 8 10)))
- (should (same-contents-p (seq-remove (lambda (elt) nil) seq) seq)))
+ (should (same-contents-p (seq-remove (lambda (_) nil) seq) seq)))
(with-test-sequences (seq '())
(should (equal (seq-remove #'test-sequences-evenp seq) '()))))
@@ -142,7 +142,7 @@ Evaluate BODY for each created sequence.
(with-test-sequences (seq '(6 7 8 9 10))
(should (equal (seq-count #'test-sequences-evenp seq) 3))
(should (equal (seq-count #'test-sequences-oddp seq) 2))
- (should (equal (seq-count (lambda (elt) nil) seq) 0)))
+ (should (equal (seq-count (lambda (_) nil) seq) 0)))
(with-test-sequences (seq '())
(should (equal (seq-count #'test-sequences-evenp seq) 0))))
@@ -199,7 +199,7 @@ Evaluate BODY for each created sequence.
(ert-deftest test-seq-every-p ()
(with-test-sequences (seq '(43 54 22 1))
- (should (seq-every-p (lambda (elt) t) seq))
+ (should (seq-every-p (lambda (_) t) seq))
(should-not (seq-every-p #'test-sequences-oddp seq))
(should-not (seq-every-p #'test-sequences-evenp seq)))
(with-test-sequences (seq '(42 54 22 2))
diff --git a/test/lisp/emacs-lisp/shadow-resources/p1/foo.el
b/test/lisp/emacs-lisp/shadow-resources/p1/foo.el
index 465038b..ffe68f9 100644
--- a/test/lisp/emacs-lisp/shadow-resources/p1/foo.el
+++ b/test/lisp/emacs-lisp/shadow-resources/p1/foo.el
@@ -1 +1 @@
-;;; This file intentionally left blank.
+;;; This file intentionally left blank. -*- lexical-binding:t -*-
diff --git a/test/lisp/emacs-lisp/shadow-resources/p2/FOO.el
b/test/lisp/emacs-lisp/shadow-resources/p2/FOO.el
index 465038b..ffe68f9 100644
--- a/test/lisp/emacs-lisp/shadow-resources/p2/FOO.el
+++ b/test/lisp/emacs-lisp/shadow-resources/p2/FOO.el
@@ -1 +1 @@
-;;; This file intentionally left blank.
+;;; This file intentionally left blank. -*- lexical-binding:t -*-
diff --git a/test/lisp/emacs-lisp/subr-x-tests.el
b/test/lisp/emacs-lisp/subr-x-tests.el
index 220ce0c..c702fdf 100644
--- a/test/lisp/emacs-lisp/subr-x-tests.el
+++ b/test/lisp/emacs-lisp/subr-x-tests.el
@@ -1,4 +1,4 @@
-;;; subr-x-tests.el --- Testing the extended lisp routines
+;;; subr-x-tests.el --- Testing the extended lisp routines -*-
lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emacs-lisp/syntax-tests.el
b/test/lisp/emacs-lisp/syntax-tests.el
new file mode 100644
index 0000000..9d4c411
--- /dev/null
+++ b/test/lisp/emacs-lisp/syntax-tests.el
@@ -0,0 +1,67 @@
+;;; syntax-tests.el --- tests for syntax.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'syntax)
+
+(ert-deftest syntax-propertize--shift-groups-and-backrefs ()
+ "Test shifting of numbered groups and back-references in regexps."
+ ;; A numbered group must be shifted.
+ (should
+ (string=
+ (syntax-propertize--shift-groups-and-backrefs
+ "\\(?2:[abc]+\\)foobar" 2)
+ "\\(?4:[abc]+\\)foobar"))
+ ;; A back-reference \1 on a normal sub-regexp context must be
+ ;; shifted.
+ (should
+ (string=
+ (syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\1" 2)
+ "\\(a\\)\\3"))
+ ;; Shifting must not happen if the \1 appears in a character class,
+ ;; or in a \{\} repetition construct (although \1 isn't valid there
+ ;; anyway).
+ (let ((rx-with-class "\\(a\\)[\\1-2]")
+ (rx-with-rep "\\(a\\)\\{1,\\1\\}"))
+ (should
+ (string=
+ (syntax-propertize--shift-groups-and-backrefs rx-with-class 2)
+ rx-with-class))
+ (should
+ (string=
+ (syntax-propertize--shift-groups-and-backrefs rx-with-rep 2)
+ rx-with-rep)))
+ ;; Now numbered groups and back-references in combination.
+ (should
+ (string=
+ (syntax-propertize--shift-groups-and-backrefs
+ "\\(?2:[abc]+\\)foo\\(\\2\\)" 2)
+ "\\(?4:[abc]+\\)foo\\(\\4\\)"))
+ ;; Emacs supports only the back-references \1,...,\9, so when a
+ ;; shift would result in \10 or more, an error must be signalled.
+ (should-error
+ (syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\3" 7)))
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
+
+;;; syntax-tests.el ends here.
diff --git a/test/lisp/emacs-lisp/text-property-search-tests.el
b/test/lisp/emacs-lisp/text-property-search-tests.el
index 26b89b7..549c90d 100644
--- a/test/lisp/emacs-lisp/text-property-search-tests.el
+++ b/test/lisp/emacs-lisp/text-property-search-tests.el
@@ -1,4 +1,4 @@
-;;; text-property-search-tests.el --- Testing text-property-search
+;;; text-property-search-tests.el --- Testing text-property-search -*-
lexical-binding:t -*-
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/emulation/viper-tests.el
b/test/lisp/emulation/viper-tests.el
index 33f85e5..b981938 100644
--- a/test/lisp/emulation/viper-tests.el
+++ b/test/lisp/emulation/viper-tests.el
@@ -1,4 +1,4 @@
-;;; viper-tests.el --- tests for viper.
+;;; viper-tests.el --- tests for viper. -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/erc/erc-track-tests.el b/test/lisp/erc/erc-track-tests.el
index b0ed4bb..457f08c 100644
--- a/test/lisp/erc/erc-track-tests.el
+++ b/test/lisp/erc/erc-track-tests.el
@@ -1,4 +1,4 @@
-;;; erc-track-tests.el --- Tests for erc-track.
+;;; erc-track-tests.el --- Tests for erc-track. -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
@@ -107,8 +107,8 @@
(ert-deftest erc-track--erc-faces-in ()
"`erc-faces-in' should pick up both 'face and 'font-lock-face properties."
- (let ((str0 "is bold")
- (str1 "is bold"))
+ (let ((str0 (copy-sequence "is bold"))
+ (str1 (copy-sequence "is bold")))
;; Turn on Font Lock mode: this initialize `char-property-alias-alist'
;; to '((face font-lock-face)). Note that `font-lock-mode' don't
;; turn on the mode if the test is run on batch mode or if the
diff --git a/test/lisp/eshell/em-hist-tests.el
b/test/lisp/eshell/em-hist-tests.el
index a08a7a2..5bb16f6 100644
--- a/test/lisp/eshell/em-hist-tests.el
+++ b/test/lisp/eshell/em-hist-tests.el
@@ -1,4 +1,4 @@
-;;; tests/em-hist-tests.el --- em-hist test suite
+;;; tests/em-hist-tests.el --- em-hist test suite -*- lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/eshell/em-ls-tests.el b/test/lisp/eshell/em-ls-tests.el
index da3e224..975701e 100644
--- a/test/lisp/eshell/em-ls-tests.el
+++ b/test/lisp/eshell/em-ls-tests.el
@@ -1,4 +1,4 @@
-;;; tests/em-ls-tests.el --- em-ls test suite
+;;; tests/em-ls-tests.el --- em-ls test suite -*- lexical-binding:t -*-
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/eshell/esh-opt-tests.el
b/test/lisp/eshell/esh-opt-tests.el
index af6c089..caba153 100644
--- a/test/lisp/eshell/esh-opt-tests.el
+++ b/test/lisp/eshell/esh-opt-tests.el
@@ -1,4 +1,4 @@
-;;; tests/esh-opt-tests.el --- esh-opt test suite
+;;; tests/esh-opt-tests.el --- esh-opt test suite -*- lexical-binding:t -*-
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 05d9cee..4b902fd 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1164,6 +1164,42 @@ works as expected if the default directory is quoted."
(should-not (make-directory a/b t))
(delete-directory dir 'recursive)))
+(ert-deftest files-tests-file-modes-symbolic-to-number ()
+ (let ((alist (list (cons "a=rwx" #o777)
+ (cons "o=t" #o1000)
+ (cons "o=xt" #o1001)
+ (cons "o=tx" #o1001) ; Order doesn't matter.
+ (cons "u=rwx,g=rx,o=rx" #o755)
+ (cons "u=rwx,g=,o=" #o700)
+ (cons "u=rwx" #o700) ; Empty permissions can be ignored.
+ (cons "u=rw,g=r,o=r" #o644)
+ (cons "u=rw,g=r,o=t" #o1640)
+ (cons "u=rw,g=r,o=xt" #o1641)
+ (cons "u=rwxs,g=rs,o=xt" #o7741)
+ (cons "u=rws,g=rs,o=t" #o7640)
+ (cons "u=rws,g=rs,o=r" #o6644)
+ (cons "a=r" #o444)
+ (cons "u=S" nil)
+ (cons "u=T" nil)
+ (cons "u=Z" nil))))
+ (dolist (x alist)
+ (if (cdr-safe x)
+ (should (equal (cdr x) (file-modes-symbolic-to-number (car x))))
+ (should-error (file-modes-symbolic-to-number (car x)))))))
+
+(ert-deftest files-tests-file-modes-number-to-symbolic ()
+ (let ((alist (list (cons #o755 "-rwxr-xr-x")
+ (cons #o700 "-rwx------")
+ (cons #o644 "-rw-r--r--")
+ (cons #o1640 "-rw-r----T")
+ (cons #o1641 "-rw-r----t")
+ (cons #o7741 "-rwsr-S--t")
+ (cons #o7640 "-rwSr-S--T")
+ (cons #o6644 "-rwSr-Sr--")
+ (cons #o444 "-r--r--r--"))))
+ (dolist (x alist)
+ (should (equal (cdr x) (file-modes-number-to-symbolic (car x)))))))
+
(ert-deftest files-tests-no-file-write-contents ()
"Test that `write-contents-functions' permits saving a file.
Usually `basic-save-buffer' will prompt for a file name if the
diff --git a/test/lisp/gnus/gnus-tests.el b/test/lisp/gnus/gnus-tests.el
index d18b3fb..fb1b204 100644
--- a/test/lisp/gnus/gnus-tests.el
+++ b/test/lisp/gnus/gnus-tests.el
@@ -1,4 +1,4 @@
-;;; gnus-tests.el --- Wrapper for the Gnus tests
+;;; gnus-tests.el --- Wrapper for the Gnus tests -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/help-mode-tests.el b/test/lisp/help-mode-tests.el
new file mode 100644
index 0000000..2b9552a
--- /dev/null
+++ b/test/lisp/help-mode-tests.el
@@ -0,0 +1,169 @@
+;;; help-mode-tests.el --- Tests for help-mode.el -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'help-mode)
+(require 'pp)
+
+(ert-deftest help-mode-tests-help-buffer ()
+ (let ((help-xref-following nil))
+ (should (equal "*Help*" (help-buffer)))))
+
+(ert-deftest help-mode-tests-help-buffer-current-buffer ()
+ (with-temp-buffer
+ (help-mode)
+ (let ((help-xref-following t))
+ (should (equal (buffer-name (current-buffer))
+ (help-buffer))))))
+
+(ert-deftest help-mode-tests-help-buffer-current-buffer-error ()
+ (with-temp-buffer
+ (let ((help-xref-following t))
+ (should-error (help-buffer)))))
+
+(ert-deftest help-mode-tests-make-xrefs ()
+ (with-temp-buffer
+ (insert "car is a built-in function in ‘C source code’.
+
+(car LIST)
+
+ Probably introduced at or before Emacs version 1.2.
+ This function does not change global state, including the match data.
+
+Return the car of LIST. If arg is nil, return nil.
+Error if arg is not nil and not a cons cell. See also ‘car-safe’.
+
+See Info node ‘(elisp)Cons Cells’ for a discussion of related basic
+Lisp concepts such as car, cdr, cons cell and list.")
+ (help-mode)
+ (help-make-xrefs)
+ (let ((car-safe-button (button-at 298)))
+ (should (eq (button-type car-safe-button) 'help-symbol))
+ (should (eq (button-get car-safe-button 'help-function)
+ #'describe-symbol)))
+ (let ((cons-cells-info-button (button-at 333)))
+ (should (eq (button-type cons-cells-info-button) 'help-info))
+ (should (eq (button-get cons-cells-info-button 'help-function)
+ #'info)))))
+
+(ert-deftest help-mode-tests-xref-button ()
+ (with-temp-buffer
+ (insert "See also the function ‘interactive’.")
+ (string-match help-xref-symbol-regexp (buffer-string))
+ (help-xref-button 8 'help-function)
+ (should-not (button-at 22))
+ (should-not (button-at 35))
+ (let ((button (button-at 30)))
+ (should (eq (button-type button) 'help-function)))))
+
+(ert-deftest help-mode-tests-insert-xref-button ()
+ (with-temp-buffer
+ (help-insert-xref-button "[back]" 'help-back)
+ (goto-char (point-min))
+ (should (eq (button-type (button-at (point))) 'help-back))
+ (help-insert-xref-button "[forward]" 'help-forward)
+ ;; The back button should stay unchanged.
+ (should (eq (button-type (button-at (point))) 'help-back))))
+
+(ert-deftest help-mode-tests-xref-on-pp ()
+ (with-temp-buffer
+ (insert (pp '(cons fill-column)))
+ (help-xref-on-pp (point-min) (point-max))
+ (goto-char (point-min))
+ (search-forward "co")
+ (should (eq (button-type (button-at (point))) 'help-function))
+ (search-forward "-")
+ (should (eq (button-type (button-at (point))) 'help-variable))))
+
+(ert-deftest help-mode-tests-xref-go-back ()
+ (let ((help-xref-stack
+ `((2 ,(lambda () (erase-buffer) (insert "bar"))))))
+ (with-temp-buffer
+ (insert "foo")
+ (help-xref-go-back (current-buffer))
+ (should (= (point) 2))
+ (should (equal (buffer-string) "bar")))))
+
+(ert-deftest help-mode-tests-xref-go-forward ()
+ (let ((help-xref-forward-stack
+ `((2 ,(lambda () (erase-buffer) (insert "bar"))))))
+ (with-temp-buffer
+ (insert "foo")
+ (help-xref-go-forward (current-buffer))
+ (should (= (point) 2))
+ (should (equal (buffer-string) "bar")))))
+
+(ert-deftest help-mode-tests-go-back ()
+ (let ((help-xref-stack
+ `((2 ,(lambda () (erase-buffer) (insert "bar"))))))
+ (with-temp-buffer
+ (insert "foo")
+ (help-go-back)
+ (should (= (point) 2))
+ (should (equal (buffer-string) "bar")))))
+
+(ert-deftest help-mode-tests-go-back-no-stack ()
+ (let ((help-xref-stack '()))
+ (should-error (help-go-back))))
+
+(ert-deftest help-mode-tests-go-forward ()
+ (let ((help-xref-forward-stack
+ `((2 ,(lambda () (erase-buffer) (insert "bar"))))))
+ (with-temp-buffer
+ (insert "foo")
+ (help-go-forward)
+ (should (= (point) 2))
+ (should (equal (buffer-string) "bar")))))
+
+(ert-deftest help-mode-tests-go-forward-no-stack ()
+ (let ((help-xref-forward-stack '()))
+ (should-error (help-go-forward))))
+
+(ert-deftest help-mode-tests-do-xref ()
+ (with-temp-buffer
+ (help-mode)
+ (help-do-xref 0 #'describe-symbol '(car))
+ (should (looking-at-p "car is a"))
+ (should (string-match-p "[back]" (buffer-string)))))
+
+(ert-deftest help-mode-tests-follow-symbol ()
+ (with-temp-buffer
+ (insert "car")
+ (help-mode)
+ (help-follow-symbol 0)
+ (should (looking-at-p "car is a"))
+ (should (string-match-p "[back]" (buffer-string)))))
+
+(ert-deftest help-mode-tests-follow-symbol-no-symbol ()
+ (with-temp-buffer
+ (insert "fXYEWnRHI0B9w6VJqQIw")
+ (help-mode)
+ (should-error (help-follow-symbol 0))))
+
+(provide 'help-mode-tests)
+;;; help-mode-tests.el ends here
diff --git a/test/lisp/imenu-tests.el b/test/lisp/imenu-tests.el
index 684a856..5dbeb88 100644
--- a/test/lisp/imenu-tests.el
+++ b/test/lisp/imenu-tests.el
@@ -1,4 +1,4 @@
-;;; imenu-tests.el --- Test suite for imenu.
+;;; imenu-tests.el --- Test suite for imenu. -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/info-xref-tests.el b/test/lisp/info-xref-tests.el
index 128b3f2..940aa7d 100644
--- a/test/lisp/info-xref-tests.el
+++ b/test/lisp/info-xref-tests.el
@@ -1,4 +1,4 @@
-;;; info-xref.el --- tests for info-xref.el
+;;; info-xref.el --- tests for info-xref.el -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/jit-lock-tests.el b/test/lisp/jit-lock-tests.el
index 445716c..dfa74cf 100644
--- a/test/lisp/jit-lock-tests.el
+++ b/test/lisp/jit-lock-tests.el
@@ -1,4 +1,4 @@
-;;; jit-lock-tests.el --- tests for jit-lock
+;;; jit-lock-tests.el --- tests for jit-lock -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/json-tests.el b/test/lisp/json-tests.el
index 05837e8..a0e8c87 100644
--- a/test/lisp/json-tests.el
+++ b/test/lisp/json-tests.el
@@ -1,4 +1,4 @@
-;;; json-tests.el --- Test suite for json.el
+;;; json-tests.el --- Test suite for json.el -*- lexical-binding:t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
@@ -21,11 +21,16 @@
(require 'ert)
(require 'json)
+(require 'map)
+(require 'seq)
+
+(eval-when-compile
+ (require 'cl-lib))
(defmacro json-tests--with-temp-buffer (content &rest body)
"Create a temporary buffer with CONTENT and evaluate BODY there.
Point is moved to beginning of the buffer."
- (declare (indent 1))
+ (declare (debug t) (indent 1))
`(with-temp-buffer
(insert ,content)
(goto-char (point-min))
@@ -33,66 +38,107 @@ Point is moved to beginning of the buffer."
;;; Utilities
-(ert-deftest test-json-join ()
- (should (equal (json-join '() ", ") ""))
- (should (equal (json-join '("a" "b" "c") ", ") "a, b, c")))
-
(ert-deftest test-json-alist-p ()
(should (json-alist-p '()))
- (should (json-alist-p '((a 1) (b 2) (c 3))))
- (should (json-alist-p '((:a 1) (:b 2) (:c 3))))
- (should (json-alist-p '(("a" 1) ("b" 2) ("c" 3))))
+ (should (json-alist-p '((()))))
+ (should (json-alist-p '((a))))
+ (should (json-alist-p '((a . 1))))
+ (should (json-alist-p '((a . 1) (b 2) (c))))
+ (should (json-alist-p '((:a) (:b 2) (:c . 3))))
+ (should (json-alist-p '(("a" . 1) ("b" 2) ("c"))))
+ (should-not (json-alist-p '(())))
+ (should-not (json-alist-p '(a)))
+ (should-not (json-alist-p '(a . 1)))
+ (should-not (json-alist-p '((a . 1) . [])))
+ (should-not (json-alist-p '((a . 1) [])))
(should-not (json-alist-p '(:a :b :c)))
(should-not (json-alist-p '(:a 1 :b 2 :c 3)))
- (should-not (json-alist-p '((:a 1) (:b 2) 3))))
+ (should-not (json-alist-p '((:a 1) (:b 2) 3)))
+ (should-not (json-alist-p '((:a 1) (:b 2) ())))
+ (should-not (json-alist-p '(((a) 1) (b 2) (c 3))))
+ (should-not (json-alist-p []))
+ (should-not (json-alist-p [(a . 1)]))
+ (should-not (json-alist-p #s(hash-table))))
(ert-deftest test-json-plist-p ()
(should (json-plist-p '()))
+ (should (json-plist-p '(:a 1)))
(should (json-plist-p '(:a 1 :b 2 :c 3)))
+ (should (json-plist-p '(:a :b)))
+ (should (json-plist-p '(:a :b :c :d)))
+ (should-not (json-plist-p '(a)))
+ (should-not (json-plist-p '(a 1)))
(should-not (json-plist-p '(a 1 b 2 c 3)))
(should-not (json-plist-p '("a" 1 "b" 2 "c" 3)))
+ (should-not (json-plist-p '(:a)))
(should-not (json-plist-p '(:a :b :c)))
- (should-not (json-plist-p '((:a 1) (:b 2) (:c 3)))))
-
-(ert-deftest test-json-plist-reverse ()
- (should (equal (json--plist-reverse '()) '()))
- (should (equal (json--plist-reverse '(:a 1)) '(:a 1)))
- (should (equal (json--plist-reverse '(:a 1 :b 2 :c 3))
+ (should-not (json-plist-p '(:a 1 :b 2 :c)))
+ (should-not (json-plist-p '((:a 1))))
+ (should-not (json-plist-p '((:a 1) (:b 2) (:c 3))))
+ (should-not (json-plist-p []))
+ (should-not (json-plist-p [:a 1]))
+ (should-not (json-plist-p #s(hash-table))))
+
+(ert-deftest test-json-plist-nreverse ()
+ (should (equal (json--plist-nreverse '()) '()))
+ (should (equal (json--plist-nreverse (list :a 1)) '(:a 1)))
+ (should (equal (json--plist-nreverse (list :a 1 :b 2)) '(:b 2 :a 1)))
+ (should (equal (json--plist-nreverse (list :a 1 :b 2 :c 3))
'(:c 3 :b 2 :a 1))))
-(ert-deftest test-json-plist-to-alist ()
- (should (equal (json--plist-to-alist '()) '()))
- (should (equal (json--plist-to-alist '(:a 1)) '((:a . 1))))
- (should (equal (json--plist-to-alist '(:a 1 :b 2 :c 3))
- '((:a . 1) (:b . 2) (:c . 3)))))
-
(ert-deftest test-json-advance ()
(json-tests--with-temp-buffer "{ \"a\": 1 }"
(json-advance 0)
- (should (= (point) (point-min)))
+ (should (bobp))
+ (json-advance)
+ (should (= (point) (1+ (point-min))))
+ (json-advance 0)
+ (should (= (point) (1+ (point-min))))
+ (json-advance 1)
+ (should (= (point) (+ (point-min) 2)))
(json-advance 3)
- (should (= (point) (+ (point-min) 3)))))
+ (should (= (point) (+ (point-min) 5)))))
(ert-deftest test-json-peek ()
(json-tests--with-temp-buffer ""
(should (zerop (json-peek))))
(json-tests--with-temp-buffer "{ \"a\": 1 }"
- (should (equal (json-peek) ?{))))
+ (should (= (json-peek) ?\{))
+ (goto-char (1- (point-max)))
+ (should (= (json-peek) ?\}))
+ (json-advance)
+ (should (zerop (json-peek)))))
(ert-deftest test-json-pop ()
(json-tests--with-temp-buffer ""
(should-error (json-pop) :type 'json-end-of-file))
(json-tests--with-temp-buffer "{ \"a\": 1 }"
- (should (equal (json-pop) ?{))
- (should (= (point) (+ (point-min) 1)))))
+ (should (= (json-pop) ?\{))
+ (should (= (point) (1+ (point-min))))
+ (goto-char (1- (point-max)))
+ (should (= (json-pop) ?\}))
+ (should-error (json-pop) :type 'json-end-of-file)))
(ert-deftest test-json-skip-whitespace ()
+ (json-tests--with-temp-buffer ""
+ (json-skip-whitespace)
+ (should (bobp))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "{}"
+ (json-skip-whitespace)
+ (should (bobp))
+ (json-advance)
+ (json-skip-whitespace)
+ (should (= (point) (1+ (point-min))))
+ (json-advance)
+ (json-skip-whitespace)
+ (should (eobp)))
(json-tests--with-temp-buffer "\t\r\n\f\b { \"a\": 1 }"
(json-skip-whitespace)
- (should (equal (char-after) ?\f)))
+ (should (= (json-peek) ?\f)))
(json-tests--with-temp-buffer "\t\r\n\t { \"a\": 1 }"
(json-skip-whitespace)
- (should (equal (char-after) ?{))))
+ (should (= (json-peek) ?\{))))
;;; Paths
@@ -113,59 +159,243 @@ Point is moved to beginning of the buffer."
(ert-deftest test-json-path-to-position-no-match ()
(let* ((json-string "{\"foo\": {\"bar\": \"baz\"}}")
(matched-path (json-path-to-position 5 json-string)))
- (should (null matched-path))))
+ (should-not matched-path)))
;;; Keywords
(ert-deftest test-json-read-keyword ()
(json-tests--with-temp-buffer "true"
- (should (json-read-keyword "true")))
+ (should (eq (json-read-keyword "true") t))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "true "
+ (should (eq (json-read-keyword "true") t))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "true}"
+ (should (eq (json-read-keyword "true") t))
+ (should (= (point) (+ (point-min) 4))))
+ (json-tests--with-temp-buffer "true false"
+ (should (eq (json-read-keyword "true") t))
+ (should (= (point) (+ (point-min) 5))))
+ (json-tests--with-temp-buffer "true }"
+ (should (eq (json-read-keyword "true") t))
+ (should (= (point) (+ (point-min) 5))))
+ (json-tests--with-temp-buffer "true |"
+ (should (eq (json-read-keyword "true") t))
+ (should (= (point) (+ (point-min) 5))))
+ (json-tests--with-temp-buffer "false"
+ (let ((json-false 'false))
+ (should (eq (json-read-keyword "false") 'false)))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "null"
+ (let ((json-null 'null))
+ (should (eq (json-read-keyword "null") 'null)))
+ (should (eobp))))
+
+(ert-deftest test-json-read-keyword-invalid ()
+ (json-tests--with-temp-buffer ""
+ (should (equal (should-error (json-read-keyword ""))
+ '(json-unknown-keyword "")))
+ (should (equal (should-error (json-read-keyword "true"))
+ '(json-unknown-keyword ()))))
(json-tests--with-temp-buffer "true"
- (should-error
- (json-read-keyword "false") :type 'json-unknown-keyword))
+ (should (equal (should-error (json-read-keyword "false"))
+ '(json-unknown-keyword "true"))))
(json-tests--with-temp-buffer "foo"
- (should-error
- (json-read-keyword "foo") :type 'json-unknown-keyword)))
+ (should (equal (should-error (json-read-keyword "foo"))
+ '(json-unknown-keyword "foo")))
+ (should (equal (should-error (json-read-keyword "bar"))
+ '(json-unknown-keyword "bar"))))
+ (json-tests--with-temp-buffer " true"
+ (should (equal (should-error (json-read-keyword "true"))
+ '(json-unknown-keyword ()))))
+ (json-tests--with-temp-buffer "truefalse"
+ (should (equal (should-error (json-read-keyword "true"))
+ '(json-unknown-keyword "truefalse"))))
+ (json-tests--with-temp-buffer "true|"
+ (should (equal (should-error (json-read-keyword "true"))
+ '(json-unknown-keyword "true")))))
(ert-deftest test-json-encode-keyword ()
(should (equal (json-encode-keyword t) "true"))
- (should (equal (json-encode-keyword json-false) "false"))
- (should (equal (json-encode-keyword json-null) "null")))
+ (let ((json-false 'false))
+ (should (equal (json-encode-keyword 'false) "false"))
+ (should (equal (json-encode-keyword json-false) "false")))
+ (let ((json-null 'null))
+ (should (equal (json-encode-keyword 'null) "null"))
+ (should (equal (json-encode-keyword json-null) "null"))))
;;; Numbers
-(ert-deftest test-json-read-number ()
- (json-tests--with-temp-buffer "3"
- (should (= (json-read-number) 3)))
- (json-tests--with-temp-buffer "-5"
- (should (= (json-read-number) -5)))
- (json-tests--with-temp-buffer "123.456"
- (should (= (json-read-number) 123.456)))
- (json-tests--with-temp-buffer "1e3"
- (should (= (json-read-number) 1e3)))
- (json-tests--with-temp-buffer "2e+3"
- (should (= (json-read-number) 2e3)))
- (json-tests--with-temp-buffer "3E3"
- (should (= (json-read-number) 3e3)))
- (json-tests--with-temp-buffer "1e-7"
- (should (= (json-read-number) 1e-7)))
- (json-tests--with-temp-buffer "abc"
- (should-error (json-read-number) :type 'json-number-format)))
+(ert-deftest test-json-read-integer ()
+ (json-tests--with-temp-buffer "0 "
+ (should (= (json-read-number) 0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0 "
+ (should (= (json-read-number) 0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "3 "
+ (should (= (json-read-number) 3))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-10 "
+ (should (= (json-read-number) -10))
+ (should (eobp)))
+ (json-tests--with-temp-buffer (format "%d " (1+ most-positive-fixnum))
+ (should (= (json-read-number) (1+ most-positive-fixnum)))
+ (should (eobp)))
+ (json-tests--with-temp-buffer (format "%d " (1- most-negative-fixnum))
+ (should (= (json-read-number) (1- most-negative-fixnum)))
+ (should (eobp))))
+
+(ert-deftest test-json-read-fraction ()
+ (json-tests--with-temp-buffer "0.0 "
+ (should (= (json-read-number) 0.0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0.0 "
+ (should (= (json-read-number) 0.0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "0.01 "
+ (should (= (json-read-number) 0.01))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0.01 "
+ (should (= (json-read-number) -0.01))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "123.456 "
+ (should (= (json-read-number) 123.456))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-123.456 "
+ (should (= (json-read-number) -123.456))
+ (should (eobp))))
+
+(ert-deftest test-json-read-exponent ()
+ (json-tests--with-temp-buffer "0e0 "
+ (should (= (json-read-number) 0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0E0 "
+ (should (= (json-read-number) 0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0E+0 "
+ (should (= (json-read-number) 0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "0e-0 "
+ (should (= (json-read-number) 0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "12e34 "
+ (should (= (json-read-number) 12e34))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-12E34 "
+ (should (= (json-read-number) -12e34))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-12E+34 "
+ (should (= (json-read-number) -12e34))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "12e-34 "
+ (should (= (json-read-number) 12e-34))
+ (should (eobp))))
+
+(ert-deftest test-json-read-fraction-exponent ()
+ (json-tests--with-temp-buffer "0.0e0 "
+ (should (= (json-read-number) 0.0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-0.0E0 "
+ (should (= (json-read-number) 0.0e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "0.12E-0 "
+ (should (= (json-read-number) 0.12e0))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "-12.34e+56 "
+ (should (= (json-read-number) -12.34e+56))
+ (should (eobp))))
+
+(ert-deftest test-json-read-number-invalid ()
+ (cl-flet ((read (str)
+ ;; Return error and point resulting from reading STR.
+ (json-tests--with-temp-buffer str
+ (cons (should-error (json-read-number)) (point)))))
+ ;; POS is where each of its STRINGS becomes invalid.
+ (pcase-dolist (`(,pos . ,strings)
+ '((1 "" "+" "-" "." "e" "e1" "abc" "++0" "++1"
+ "+0" "+0.0" "+12" "+12.34" "+12.34e56"
+ ".0" "+.0" "-.0" ".12" "+.12" "-.12"
+ ".e0" "+.e0" "-.e0" ".0e0" "+.0e0" "-.0e0")
+ (2 "01" "1ee1" "1e++1")
+ (3 "-01")
+ (4 "0.0.0" "1.1.1" "1e1e1")
+ (5 "-0.0.0" "-1.1.1")))
+ ;; Expected error and point.
+ (let ((res `((json-number-format ,pos) . ,pos)))
+ (dolist (str strings)
+ (should (equal (read str) res)))))))
(ert-deftest test-json-encode-number ()
+ (should (equal (json-encode-number 0) "0"))
+ (should (equal (json-encode-number -0) "0"))
(should (equal (json-encode-number 3) "3"))
(should (equal (json-encode-number -5) "-5"))
- (should (equal (json-encode-number 123.456) "123.456")))
+ (should (equal (json-encode-number 123.456) "123.456"))
+ (let ((bignum (1+ most-positive-fixnum)))
+ (should (equal (json-encode-number bignum)
+ (number-to-string bignum)))))
-;; Strings
+;;; Strings
(ert-deftest test-json-read-escaped-char ()
(json-tests--with-temp-buffer "\\\""
- (should (equal (json-read-escaped-char) ?\"))))
+ (should (= (json-read-escaped-char) ?\"))
+ (should (eobp)))
+ (json-tests--with-temp-buffer "\\\\ "
+ (should (= (json-read-escaped-char) ?\\))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\b "
+ (should (= (json-read-escaped-char) ?\b))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\f "
+ (should (= (json-read-escaped-char) ?\f))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\n "
+ (should (= (json-read-escaped-char) ?\n))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\r "
+ (should (= (json-read-escaped-char) ?\r))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\t "
+ (should (= (json-read-escaped-char) ?\t))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\x "
+ (should (= (json-read-escaped-char) ?x))
+ (should (= (point) (+ (point-min) 2))))
+ (json-tests--with-temp-buffer "\\ud800\\uDC00 "
+ (should (= (json-read-escaped-char) #x10000))
+ (should (= (point) (+ (point-min) 12))))
+ (json-tests--with-temp-buffer "\\ud7ff\\udc00 "
+ (should (= (json-read-escaped-char) #xd7ff))
+ (should (= (point) (+ (point-min) 6))))
+ (json-tests--with-temp-buffer "\\uffff "
+ (should (= (json-read-escaped-char) #xffff))
+ (should (= (point) (+ (point-min) 6))))
+ (json-tests--with-temp-buffer "\\ufffff "
+ (should (= (json-read-escaped-char) #xffff))
+ (should (= (point) (+ (point-min) 6)))))
+
+(ert-deftest test-json-read-escaped-char-invalid ()
+ (json-tests--with-temp-buffer ""
+ (should-error (json-read-escaped-char)))
+ (json-tests--with-temp-buffer "\\"
+ (should-error (json-read-escaped-char) :type 'json-end-of-file))
+ (json-tests--with-temp-buffer "\\ufff "
+ (should (equal (should-error (json-read-escaped-char))
+ (list 'json-string-escape (+ (point-min) 2)))))
+ (json-tests--with-temp-buffer "\\ufffg "
+ (should (equal (should-error (json-read-escaped-char))
+ (list 'json-string-escape (+ (point-min) 2))))))
(ert-deftest test-json-read-string ()
+ (json-tests--with-temp-buffer ""
+ (should-error (json-read-string)))
(json-tests--with-temp-buffer "\"formfeed\f\""
- (should-error (json-read-string) :type 'json-string-format))
+ (should (equal (should-error (json-read-string))
+ '(json-string-format ?\f))))
+ (json-tests--with-temp-buffer "\"\""
+ (should (equal (json-read-string) "")))
(json-tests--with-temp-buffer "\"foo \\\"bar\\\"\""
(should (equal (json-read-string) "foo \"bar\"")))
(json-tests--with-temp-buffer "\"abcαβγ\""
@@ -175,57 +405,117 @@ Point is moved to beginning of the buffer."
;; Bug#24784
(json-tests--with-temp-buffer "\"\\uD834\\uDD1E\""
(should (equal (json-read-string) "\U0001D11E")))
+ (json-tests--with-temp-buffer "f"
+ (should-error (json-read-string) :type 'json-end-of-file))
(json-tests--with-temp-buffer "foo"
- (should-error (json-read-string) :type 'json-string-format)))
+ (should-error (json-read-string) :type 'json-end-of-file)))
(ert-deftest test-json-encode-string ()
+ (should (equal (json-encode-string "") "\"\""))
+ (should (equal (json-encode-string "a") "\"a\""))
(should (equal (json-encode-string "foo") "\"foo\""))
(should (equal (json-encode-string "a\n\fb") "\"a\\n\\fb\""))
(should (equal (json-encode-string "\nasdфыв\u001f\u007ffgh\t")
"\"\\nasdфыв\\u001f\u007ffgh\\t\"")))
(ert-deftest test-json-encode-key ()
+ (should (equal (json-encode-key "") "\"\""))
+ (should (equal (json-encode-key '##) "\"\""))
+ (should (equal (json-encode-key :) "\"\""))
(should (equal (json-encode-key "foo") "\"foo\""))
(should (equal (json-encode-key 'foo) "\"foo\""))
(should (equal (json-encode-key :foo) "\"foo\""))
- (should-error (json-encode-key 5) :type 'json-key-format)
- (should-error (json-encode-key ["foo"]) :type 'json-key-format)
- (should-error (json-encode-key '("foo")) :type 'json-key-format))
+ (should (equal (should-error (json-encode-key 5))
+ '(json-key-format 5)))
+ (should (equal (should-error (json-encode-key ["foo"]))
+ '(json-key-format ["foo"])))
+ (should (equal (should-error (json-encode-key '("foo")))
+ '(json-key-format ("foo")))))
;;; Objects
(ert-deftest test-json-new-object ()
(let ((json-object-type 'alist))
- (should (equal (json-new-object) '())))
+ (should-not (json-new-object)))
(let ((json-object-type 'plist))
- (should (equal (json-new-object) '())))
+ (should-not (json-new-object)))
(let* ((json-object-type 'hash-table)
(json-object (json-new-object)))
(should (hash-table-p json-object))
- (should (= (hash-table-count json-object) 0))))
+ (should (map-empty-p json-object))
+ (should (eq (hash-table-test json-object) #'equal))))
-(ert-deftest test-json-add-to-object ()
+(ert-deftest test-json-add-to-alist ()
(let* ((json-object-type 'alist)
- (json-key-type nil)
(obj (json-new-object)))
- (setq obj (json-add-to-object obj "a" 1))
- (setq obj (json-add-to-object obj "b" 2))
- (should (equal (assq 'a obj) '(a . 1)))
- (should (equal (assq 'b obj) '(b . 2))))
+ (let ((json-key-type nil))
+ (setq obj (json-add-to-object obj "a" 1))
+ (setq obj (json-add-to-object obj "b" 2))
+ (should (equal (assq 'a obj) '(a . 1)))
+ (should (equal (assq 'b obj) '(b . 2))))
+ (let ((json-key-type 'symbol))
+ (setq obj (json-add-to-object obj "c" 3))
+ (setq obj (json-add-to-object obj "d" 4))
+ (should (equal (assq 'c obj) '(c . 3)))
+ (should (equal (assq 'd obj) '(d . 4))))
+ (let ((json-key-type 'keyword))
+ (setq obj (json-add-to-object obj "e" 5))
+ (setq obj (json-add-to-object obj "f" 6))
+ (should (equal (assq :e obj) '(:e . 5)))
+ (should (equal (assq :f obj) '(:f . 6))))
+ (let ((json-key-type 'string))
+ (setq obj (json-add-to-object obj "g" 7))
+ (setq obj (json-add-to-object obj "h" 8))
+ (should (equal (assoc "g" obj) '("g" . 7)))
+ (should (equal (assoc "h" obj) '("h" . 8))))))
+
+(ert-deftest test-json-add-to-plist ()
(let* ((json-object-type 'plist)
- (json-key-type nil)
(obj (json-new-object)))
- (setq obj (json-add-to-object obj "a" 1))
- (setq obj (json-add-to-object obj "b" 2))
- (should (= (plist-get obj :a) 1))
- (should (= (plist-get obj :b) 2)))
+ (let ((json-key-type nil))
+ (setq obj (json-add-to-object obj "a" 1))
+ (setq obj (json-add-to-object obj "b" 2))
+ (should (= (plist-get obj :a) 1))
+ (should (= (plist-get obj :b) 2)))
+ (let ((json-key-type 'keyword))
+ (setq obj (json-add-to-object obj "c" 3))
+ (setq obj (json-add-to-object obj "d" 4))
+ (should (= (plist-get obj :c) 3))
+ (should (= (plist-get obj :d) 4)))
+ (let ((json-key-type 'symbol))
+ (setq obj (json-add-to-object obj "e" 5))
+ (setq obj (json-add-to-object obj "f" 6))
+ (should (= (plist-get obj 'e) 5))
+ (should (= (plist-get obj 'f) 6)))
+ (let ((json-key-type 'string))
+ (setq obj (json-add-to-object obj "g" 7))
+ (setq obj (json-add-to-object obj "h" 8))
+ (should (= (lax-plist-get obj "g") 7))
+ (should (= (lax-plist-get obj "h") 8)))))
+
+(ert-deftest test-json-add-to-hash-table ()
(let* ((json-object-type 'hash-table)
- (json-key-type nil)
(obj (json-new-object)))
- (setq obj (json-add-to-object obj "a" 1))
- (setq obj (json-add-to-object obj "b" 2))
- (should (= (gethash "a" obj) 1))
- (should (= (gethash "b" obj) 2))))
+ (let ((json-key-type nil))
+ (setq obj (json-add-to-object obj "a" 1))
+ (setq obj (json-add-to-object obj "b" 2))
+ (should (= (gethash "a" obj) 1))
+ (should (= (gethash "b" obj) 2)))
+ (let ((json-key-type 'string))
+ (setq obj (json-add-to-object obj "c" 3))
+ (setq obj (json-add-to-object obj "d" 4))
+ (should (= (gethash "c" obj) 3))
+ (should (= (gethash "d" obj) 4)))
+ (let ((json-key-type 'symbol))
+ (setq obj (json-add-to-object obj "e" 5))
+ (setq obj (json-add-to-object obj "f" 6))
+ (should (= (gethash 'e obj) 5))
+ (should (= (gethash 'f obj) 6)))
+ (let ((json-key-type 'keyword))
+ (setq obj (json-add-to-object obj "g" 7))
+ (setq obj (json-add-to-object obj "h" 8))
+ (should (= (gethash :g obj) 7))
+ (should (= (gethash :h obj) 8)))))
(ert-deftest test-json-read-object ()
(json-tests--with-temp-buffer "{ \"a\": 1, \"b\": 2 }"
@@ -238,94 +528,384 @@ Point is moved to beginning of the buffer."
(let* ((json-object-type 'hash-table)
(hash-table (json-read-object)))
(should (= (gethash "a" hash-table) 1))
- (should (= (gethash "b" hash-table) 2))))
+ (should (= (gethash "b" hash-table) 2)))))
+
+(ert-deftest test-json-read-object-empty ()
+ (json-tests--with-temp-buffer "{}"
+ (let ((json-object-type 'alist))
+ (should-not (save-excursion (json-read-object))))
+ (let ((json-object-type 'plist))
+ (should-not (save-excursion (json-read-object))))
+ (let* ((json-object-type 'hash-table)
+ (hash-table (json-read-object)))
+ (should (hash-table-p hash-table))
+ (should (map-empty-p hash-table)))))
+
+(ert-deftest test-json-read-object-invalid ()
+ (json-tests--with-temp-buffer "{ \"a\" 1, \"b\": 2 }"
+ (should (equal (should-error (json-read-object))
+ '(json-object-format ":" ?1))))
(json-tests--with-temp-buffer "{ \"a\": 1 \"b\": 2 }"
- (should-error (json-read-object) :type 'json-object-format)))
+ (should (equal (should-error (json-read-object))
+ '(json-object-format "," ?\")))))
+
+(ert-deftest test-json-read-object-function ()
+ (let* ((pre nil)
+ (post nil)
+ (keys '("b" "a"))
+ (json-pre-element-read-function
+ (lambda (key)
+ (setq pre 'pre)
+ (should (equal key (pop keys)))))
+ (json-post-element-read-function
+ (lambda () (setq post 'post))))
+ (json-tests--with-temp-buffer "{ \"b\": 2, \"a\": 1 }"
+ (json-read-object)
+ (should (eq pre 'pre))
+ (should (eq post 'post)))))
(ert-deftest test-json-encode-hash-table ()
- (let ((hash-table (make-hash-table))
- (json-encoding-object-sort-predicate 'string<)
+ (let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
- (puthash :a 1 hash-table)
- (puthash :b 2 hash-table)
- (puthash :c 3 hash-table)
- (should (equal (json-encode hash-table)
- "{\"a\":1,\"b\":2,\"c\":3}"))))
-
-(ert-deftest json-encode-simple-alist ()
- (let ((json-encoding-pretty-print nil))
- (should (equal (json-encode '((a . 1) (b . 2)))
- "{\"a\":1,\"b\":2}"))))
-
-(ert-deftest test-json-encode-plist ()
- (let ((plist '(:a 1 :b 2))
+ (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
+ (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
+ "{\"a\":1}"))
+ (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
+ '("{\"a\":1,\"b\":2}" "{\"b\":2,\"a\":1}")))
+ (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
+ '("{\"a\":1,\"b\":2,\"c\":3}"
+ "{\"a\":1,\"c\":3,\"b\":2}"
+ "{\"b\":2,\"a\":1,\"c\":3}"
+ "{\"b\":2,\"c\":3,\"a\":1}"
+ "{\"c\":3,\"a\":1,\"b\":2}"
+ "{\"c\":3,\"b\":2,\"a\":1}")))))
+
+(ert-deftest test-json-encode-hash-table-pretty ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings nil))
+ (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
+ (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
+ "{\n \"a\": 1\n}"))
+ (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
+ '("{\n \"a\": 1,\n \"b\": 2\n}"
+ "{\n \"b\": 2,\n \"a\": 1\n}")))
+ (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
+ '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3\n}"
+ "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2\n}"
+ "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3\n}"
+ "{\n \"b\": 2,\n \"c\": 3,\n \"a\": 1\n}"
+ "{\n \"c\": 3,\n \"a\": 1,\n \"b\": 2\n}"
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}")))))
+
+(ert-deftest test-json-encode-hash-table-lisp-style ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings t))
+ (should (equal (json-encode-hash-table #s(hash-table)) "{}"))
+ (should (equal (json-encode-hash-table #s(hash-table data (a 1)))
+ "{\n \"a\": 1}"))
+ (should (member (json-encode-hash-table #s(hash-table data (b 2 a 1)))
+ '("{\n \"a\": 1,\n \"b\": 2}"
+ "{\n \"b\": 2,\n \"a\": 1}")))
+ (should (member (json-encode-hash-table #s(hash-table data (c 3 b 2 a 1)))
+ '("{\n \"a\": 1,\n \"b\": 2,\n \"c\": 3}"
+ "{\n \"a\": 1,\n \"c\": 3,\n \"b\": 2}"
+ "{\n \"b\": 2,\n \"a\": 1,\n \"c\": 3}"
+ "{\n \"b\": 2,\n \"c\": 3,\n \"a\": 1}"
+ "{\n \"c\": 3,\n \"a\": 1,\n \"b\": 2}"
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}")))))
+
+(ert-deftest test-json-encode-hash-table-sort ()
+ (let ((json-encoding-object-sort-predicate #'string<)
(json-encoding-pretty-print nil))
- (should (equal (json-encode plist) "{\"a\":1,\"b\":2}"))))
-
-(ert-deftest test-json-encode-plist-with-sort-predicate ()
- (let ((plist '(:c 3 :a 1 :b 2))
- (json-encoding-object-sort-predicate 'string<)
+ (pcase-dolist (`(,in . ,out)
+ '((#s(hash-table) . "{}")
+ (#s(hash-table data (a 1)) . "{\"a\":1}")
+ (#s(hash-table data (b 2 a 1)) . "{\"a\":1,\"b\":2}")
+ (#s(hash-table data (c 3 b 2 a 1))
+ . "{\"a\":1,\"b\":2,\"c\":3}")))
+ (let ((copy (map-pairs in)))
+ (should (equal (json-encode-hash-table in) out))
+ ;; Ensure sorting isn't destructive.
+ (should (seq-set-equal-p (map-pairs in) copy))))))
+
+(ert-deftest test-json-encode-alist ()
+ (let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
- (should (equal (json-encode plist) "{\"a\":1,\"b\":2,\"c\":3}"))))
+ (should (equal (json-encode-alist ()) "{}"))
+ (should (equal (json-encode-alist '((a . 1))) "{\"a\":1}"))
+ (should (equal (json-encode-alist '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}"))
+ (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1)))
+ "{\"c\":3,\"b\":2,\"a\":1}"))))
+
+(ert-deftest test-json-encode-alist-pretty ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings nil))
+ (should (equal (json-encode-alist ()) "{}"))
+ (should (equal (json-encode-alist '((a . 1))) "{\n \"a\": 1\n}"))
+ (should (equal (json-encode-alist '((b . 2) (a . 1)))
+ "{\n \"b\": 2,\n \"a\": 1\n}"))
+ (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1)))
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}"))))
+
+(ert-deftest test-json-encode-alist-lisp-style ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings t))
+ (should (equal (json-encode-alist ()) "{}"))
+ (should (equal (json-encode-alist '((a . 1))) "{\n \"a\": 1}"))
+ (should (equal (json-encode-alist '((b . 2) (a . 1)))
+ "{\n \"b\": 2,\n \"a\": 1}"))
+ (should (equal (json-encode-alist '((c . 3) (b . 2) (a . 1)))
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}"))))
+
+(ert-deftest test-json-encode-alist-sort ()
+ (let ((json-encoding-object-sort-predicate #'string<)
+ (json-encoding-pretty-print nil))
+ (pcase-dolist (`(,in . ,out)
+ '((() . "{}")
+ (((a . 1)) . "{\"a\":1}")
+ (((b . 2) (a . 1)) . "{\"a\":1,\"b\":2}")
+ (((c . 3) (b . 2) (a . 1))
+ . "{\"a\":1,\"b\":2,\"c\":3}")))
+ (let ((copy (copy-alist in)))
+ (should (equal (json-encode-alist in) out))
+ ;; Ensure sorting isn't destructive (bug#40693).
+ (should (equal in copy))))))
-(ert-deftest test-json-encode-alist-with-sort-predicate ()
- (let ((alist '((:c . 3) (:a . 1) (:b . 2)))
- (json-encoding-object-sort-predicate 'string<)
+(ert-deftest test-json-encode-plist ()
+ (let ((json-encoding-object-sort-predicate nil)
(json-encoding-pretty-print nil))
- (should (equal (json-encode alist) "{\"a\":1,\"b\":2,\"c\":3}"))))
+ (should (equal (json-encode-plist ()) "{}"))
+ (should (equal (json-encode-plist '(:a 1)) "{\"a\":1}"))
+ (should (equal (json-encode-plist '(:b 2 :a 1)) "{\"b\":2,\"a\":1}"))
+ (should (equal (json-encode-plist '(:c 3 :b 2 :a 1))
+ "{\"c\":3,\"b\":2,\"a\":1}"))))
+
+(ert-deftest test-json-encode-plist-pretty ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings nil))
+ (should (equal (json-encode-plist ()) "{}"))
+ (should (equal (json-encode-plist '(:a 1)) "{\n \"a\": 1\n}"))
+ (should (equal (json-encode-plist '(:b 2 :a 1))
+ "{\n \"b\": 2,\n \"a\": 1\n}"))
+ (should (equal (json-encode-plist '(:c 3 :b 2 :a 1))
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1\n}"))))
+
+(ert-deftest test-json-encode-plist-lisp-style ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings t))
+ (should (equal (json-encode-plist ()) "{}"))
+ (should (equal (json-encode-plist '(:a 1)) "{\n \"a\": 1}"))
+ (should (equal (json-encode-plist '(:b 2 :a 1))
+ "{\n \"b\": 2,\n \"a\": 1}"))
+ (should (equal (json-encode-plist '(:c 3 :b 2 :a 1))
+ "{\n \"c\": 3,\n \"b\": 2,\n \"a\": 1}"))))
+
+(ert-deftest test-json-encode-plist-sort ()
+ (let ((json-encoding-object-sort-predicate #'string<)
+ (json-encoding-pretty-print nil))
+ (pcase-dolist (`(,in . ,out)
+ '((() . "{}")
+ ((:a 1) . "{\"a\":1}")
+ ((:b 2 :a 1) . "{\"a\":1,\"b\":2}")
+ ((:c 3 :b 2 :a 1) . "{\"a\":1,\"b\":2,\"c\":3}")))
+ (let ((copy (copy-sequence in)))
+ (should (equal (json-encode-plist in) out))
+ ;; Ensure sorting isn't destructive.
+ (should (equal in copy))))))
(ert-deftest test-json-encode-list ()
- (let ((json-encoding-pretty-print nil))
- (should (equal (json-encode-list '(:a 1 :b 2))
- "{\"a\":1,\"b\":2}"))
- (should (equal (json-encode-list '((:a . 1) (:b . 2)))
- "{\"a\":1,\"b\":2}"))
- (should (equal (json-encode-list '(1 2 3 4)) "[1,2,3,4]"))))
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print nil))
+ (should (equal (json-encode-list ()) "{}"))
+ (should (equal (json-encode-list '(a)) "[\"a\"]"))
+ (should (equal (json-encode-list '(:a)) "[\"a\"]"))
+ (should (equal (json-encode-list '("a")) "[\"a\"]"))
+ (should (equal (json-encode-list '(a 1)) "[\"a\",1]"))
+ (should (equal (json-encode-list '("a" 1)) "[\"a\",1]"))
+ (should (equal (json-encode-list '(:a 1)) "{\"a\":1}"))
+ (should (equal (json-encode-list '((a . 1))) "{\"a\":1}"))
+ (should (equal (json-encode-list '((:a . 1))) "{\"a\":1}"))
+ (should (equal (json-encode-list '(:b 2 :a)) "[\"b\",2,\"a\"]"))
+ (should (equal (json-encode-list '(4 3 2 1)) "[4,3,2,1]"))
+ (should (equal (json-encode-list '(b 2 a 1)) "[\"b\",2,\"a\",1]"))
+ (should (equal (json-encode-list '(:b 2 :a 1)) "{\"b\":2,\"a\":1}"))
+ (should (equal (json-encode-list '((b . 2) (a . 1))) "{\"b\":2,\"a\":1}"))
+ (should (equal (json-encode-list '((:b . 2) (:a . 1)))
+ "{\"b\":2,\"a\":1}"))
+ (should (equal (json-encode-list '((a) 1)) "[[\"a\"],1]"))
+ (should (equal (json-encode-list '((:a) 1)) "[[\"a\"],1]"))
+ (should (equal (json-encode-list '(("a") 1)) "[[\"a\"],1]"))
+ (should (equal (json-encode-list '((a 1) 2)) "[[\"a\",1],2]"))
+ (should (equal (json-encode-list '((:a 1) 2)) "[{\"a\":1},2]"))
+ (should (equal (json-encode-list '(((a . 1)) 2)) "[{\"a\":1},2]"))
+ (should (equal (json-encode-list '(:a 1 :b (2))) "{\"a\":1,\"b\":[2]}"))
+ (should (equal (json-encode-list '((a . 1) (b 2))) "{\"a\":1,\"b\":[2]}"))
+ (should-error (json-encode-list '(a . 1)) :type 'wrong-type-argument)
+ (should-error (json-encode-list '((a . 1) 2)) :type 'wrong-type-argument)
+ (should (equal (should-error (json-encode-list []))
+ '(json-error [])))
+ (should (equal (should-error (json-encode-list [a]))
+ '(json-error [a])))))
;;; Arrays
(ert-deftest test-json-read-array ()
(let ((json-array-type 'vector))
+ (json-tests--with-temp-buffer "[]"
+ (should (equal (json-read-array) [])))
+ (json-tests--with-temp-buffer "[ ]"
+ (should (equal (json-read-array) [])))
+ (json-tests--with-temp-buffer "[1]"
+ (should (equal (json-read-array) [1])))
(json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]"
(should (equal (json-read-array) [1 2 "a" "b"]))))
(let ((json-array-type 'list))
+ (json-tests--with-temp-buffer "[]"
+ (should-not (json-read-array)))
+ (json-tests--with-temp-buffer "[ ]"
+ (should-not (json-read-array)))
+ (json-tests--with-temp-buffer "[1]"
+ (should (equal (json-read-array) '(1))))
(json-tests--with-temp-buffer "[1, 2, \"a\", \"b\"]"
(should (equal (json-read-array) '(1 2 "a" "b")))))
(json-tests--with-temp-buffer "[1 2]"
- (should-error (json-read-array) :type 'json-error)))
+ (should (equal (should-error (json-read-array))
+ '(json-array-format "," ?2)))))
+
+(ert-deftest test-json-read-array-function ()
+ (let* ((pre nil)
+ (post nil)
+ (keys '(0 1))
+ (json-pre-element-read-function
+ (lambda (key)
+ (setq pre 'pre)
+ (should (equal key (pop keys)))))
+ (json-post-element-read-function
+ (lambda () (setq post 'post))))
+ (json-tests--with-temp-buffer "[1, 0]"
+ (json-read-array)
+ (should (eq pre 'pre))
+ (should (eq post 'post)))))
(ert-deftest test-json-encode-array ()
- (let ((json-encoding-pretty-print nil))
- (should (equal (json-encode-array [1 2 "a" "b"])
- "[1,2,\"a\",\"b\"]"))))
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print nil))
+ (should (equal (json-encode-array ()) "[]"))
+ (should (equal (json-encode-array []) "[]"))
+ (should (equal (json-encode-array '(1)) "[1]"))
+ (should (equal (json-encode-array '[1]) "[1]"))
+ (should (equal (json-encode-array '(2 1)) "[2,1]"))
+ (should (equal (json-encode-array '[2 1]) "[2,1]"))
+ (should (equal (json-encode-array '[:b a 2 1]) "[\"b\",\"a\",2,1]"))))
+
+(ert-deftest test-json-encode-array-pretty ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings nil))
+ (should (equal (json-encode-array ()) "[]"))
+ (should (equal (json-encode-array []) "[]"))
+ (should (equal (json-encode-array '(1)) "[\n 1\n]"))
+ (should (equal (json-encode-array '[1]) "[\n 1\n]"))
+ (should (equal (json-encode-array '(2 1)) "[\n 2,\n 1\n]"))
+ (should (equal (json-encode-array '[2 1]) "[\n 2,\n 1\n]"))
+ (should (equal (json-encode-array '[:b a 2 1])
+ "[\n \"b\",\n \"a\",\n 2,\n 1\n]"))))
+
+(ert-deftest test-json-encode-array-lisp-style ()
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print t)
+ (json-encoding-default-indentation " ")
+ (json-encoding-lisp-style-closings t))
+ (should (equal (json-encode-array ()) "[]"))
+ (should (equal (json-encode-array []) "[]"))
+ (should (equal (json-encode-array '(1)) "[\n 1]"))
+ (should (equal (json-encode-array '[1]) "[\n 1]"))
+ (should (equal (json-encode-array '(2 1)) "[\n 2,\n 1]"))
+ (should (equal (json-encode-array '[2 1]) "[\n 2,\n 1]"))
+ (should (equal (json-encode-array '[:b a 2 1])
+ "[\n \"b\",\n \"a\",\n 2,\n 1]"))))
;;; Reader
(ert-deftest test-json-read ()
- (json-tests--with-temp-buffer "{ \"a\": 1 }"
- ;; We don't care exactly what the return value is (that is tested
- ;; in `test-json-read-object'), but it should parse without error.
- (should (json-read)))
+ (pcase-dolist (`(,fn . ,contents)
+ '((json-read-string "\"\"" "\"a\"")
+ (json-read-array "[]" "[1]")
+ (json-read-object "{}" "{\"a\":1}")
+ (json-read-keyword "null" "false" "true")
+ (json-read-number
+ "-0" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")))
+ (dolist (content contents)
+ ;; Check that leading whitespace is skipped.
+ (dolist (str (list content (concat " " content)))
+ (cl-letf* ((called nil)
+ ((symbol-function fn)
+ (lambda (&rest _) (setq called t))))
+ (json-tests--with-temp-buffer str
+ ;; We don't care exactly what the return value is (that is
+ ;; tested elsewhere), but it should parse without error.
+ (should (json-read))
+ (should called)))))))
+
+(ert-deftest test-json-read-invalid ()
(json-tests--with-temp-buffer ""
(should-error (json-read) :type 'json-end-of-file))
- (json-tests--with-temp-buffer "xxx"
- (let ((err (should-error (json-read) :type 'json-readtable-error)))
- (should (equal (cdr err) '(?x))))))
+ (json-tests--with-temp-buffer " "
+ (should-error (json-read) :type 'json-end-of-file))
+ (json-tests--with-temp-buffer "x"
+ (should (equal (should-error (json-read))
+ '(json-readtable-error ?x))))
+ (json-tests--with-temp-buffer " x"
+ (should (equal (should-error (json-read))
+ '(json-readtable-error ?x)))))
(ert-deftest test-json-read-from-string ()
- (let ((json-string "{ \"a\": 1 }"))
- (json-tests--with-temp-buffer json-string
- (should (equal (json-read-from-string json-string)
+ (dolist (str '("\"\"" "\"a\"" "[]" "[1]" "{}" "{\"a\":1}"
+ "null" "false" "true" "0" "123"))
+ (json-tests--with-temp-buffer str
+ (should (equal (json-read-from-string str)
(json-read))))))
-;;; JSON encoder
+;;; Encoder
(ert-deftest test-json-encode ()
+ (should (equal (json-encode t) "true"))
+ (let ((json-null 'null))
+ (should (equal (json-encode json-null) "null")))
+ (let ((json-false 'false))
+ (should (equal (json-encode json-false) "false")))
+ (should (equal (json-encode "") "\"\""))
(should (equal (json-encode "foo") "\"foo\""))
+ (should (equal (json-encode :) "\"\""))
+ (should (equal (json-encode :foo) "\"foo\""))
+ (should (equal (json-encode '(1)) "[1]"))
+ (should (equal (json-encode 'foo) "\"foo\""))
+ (should (equal (json-encode 0) "0"))
+ (should (equal (json-encode 123) "123"))
+ (let ((json-encoding-object-sort-predicate nil)
+ (json-encoding-pretty-print nil))
+ (should (equal (json-encode []) "[]"))
+ (should (equal (json-encode [1]) "[1]"))
+ (should (equal (json-encode #s(hash-table)) "{}"))
+ (should (equal (json-encode #s(hash-table data (a 1))) "{\"a\":1}")))
(with-temp-buffer
- (should-error (json-encode (current-buffer)) :type 'json-error)))
+ (should (equal (should-error (json-encode (current-buffer)))
+ (list 'json-error (current-buffer))))))
-;;; Pretty-print
+;;; Pretty printing & minimizing
(defun json-tests-equal-pretty-print (original &optional expected)
"Abort current test if pretty-printing ORIGINAL does not yield EXPECTED.
@@ -351,46 +931,45 @@ nil, ORIGINAL should stay unchanged by pretty-printing."
(json-tests-equal-pretty-print "0.123"))
(ert-deftest test-json-pretty-print-object ()
- ;; empty (regression test for bug#24252)
- (json-tests-equal-pretty-print
- "{}"
- "{\n}")
- ;; one pair
+ ;; Empty (regression test for bug#24252).
+ (json-tests-equal-pretty-print "{}")
+ ;; One pair.
(json-tests-equal-pretty-print
"{\"key\":1}"
"{\n \"key\": 1\n}")
- ;; two pairs
+ ;; Two pairs.
(json-tests-equal-pretty-print
"{\"key1\":1,\"key2\":2}"
"{\n \"key1\": 1,\n \"key2\": 2\n}")
- ;; embedded object
+ ;; Nested object.
(json-tests-equal-pretty-print
"{\"foo\":{\"key\":1}}"
"{\n \"foo\": {\n \"key\": 1\n }\n}")
- ;; embedded array
+ ;; Nested array.
(json-tests-equal-pretty-print
"{\"key\":[1,2]}"
"{\n \"key\": [\n 1,\n 2\n ]\n}"))
(ert-deftest test-json-pretty-print-array ()
- ;; empty
+ ;; Empty.
(json-tests-equal-pretty-print "[]")
- ;; one item
+ ;; One item.
(json-tests-equal-pretty-print
"[1]"
"[\n 1\n]")
- ;; two items
+ ;; Two items.
(json-tests-equal-pretty-print
"[1,2]"
"[\n 1,\n 2\n]")
- ;; embedded object
+ ;; Nested object.
(json-tests-equal-pretty-print
"[{\"key\":1}]"
"[\n {\n \"key\": 1\n }\n]")
- ;; embedded array
+ ;; Nested array.
(json-tests-equal-pretty-print
"[[1,2]]"
"[\n [\n 1,\n 2\n ]\n]"))
(provide 'json-tests)
+
;;; json-tests.el ends here
diff --git a/test/lisp/mail/qp-tests.el b/test/lisp/mail/qp-tests.el
new file mode 100644
index 0000000..8d70449
--- /dev/null
+++ b/test/lisp/mail/qp-tests.el
@@ -0,0 +1,74 @@
+;;; qp-tests.el --- Tests for qp.el -*- lexical-binding:t; coding:utf-8 -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Stefan Kangas <stefankangas@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'qp)
+
+;; Quote by Antoine de Saint-Exupéry, Citadelle (1948)
+;; from https://en.wikipedia.org/wiki/Quoted-printable
+(defvar qp-tests-quote-qp
+ (concat "J'interdis aux marchands de vanter trop leurs marchandises. Car ils
se font =\n"
+ "vite p=C3=A9dagogues et t'enseignent comme but ce qui n'est par
essence qu'=\n"
+ "un moyen, et te trompant ainsi sur la route =C3=A0 suivre les
voil=C3=A0 bi=\n"
+ "ent=C3=B4t qui te d=C3=A9gradent, car si leur musique est vulgaire
ils te f=\n"
+ "abriquent pour te la vendre une =C3=A2me vulgaire."))
+(defvar qp-tests-quote-utf8
+ (concat "J'interdis aux marchands de vanter trop leurs marchandises. Car ils
se font "
+ "vite pédagogues et t'enseignent comme but ce qui n'est par essence
qu'"
+ "un moyen, et te trompant ainsi sur la route à suivre les voilà bi"
+ "entôt qui te dégradent, car si leur musique est vulgaire ils te f"
+ "abriquent pour te la vendre une âme vulgaire."))
+
+(ert-deftest qp-test--quoted-printable-decode-region ()
+ (with-temp-buffer
+ (insert qp-tests-quote-qp)
+ (encode-coding-region (point-min) (point-max) 'utf-8)
+ (quoted-printable-decode-region (point-min) (point-max) 'utf-8)
+ (should (equal (buffer-string) qp-tests-quote-utf8))))
+
+(ert-deftest qp-test--quoted-printable-decode-string ()
+ (should (equal (quoted-printable-decode-string "foo!") "foo!"))
+ (should (equal (quoted-printable-decode-string "=0C") "\^L"))
+ (should (equal (quoted-printable-decode-string "=3D") "="))
+ (should (equal (quoted-printable-decode-string "=A1Hola, se=F1or!?")
+ "\241Hola, se\361or!?")))
+
+(ert-deftest qp-test--quoted-printable-encode-region ()
+ (with-temp-buffer
+ (insert (make-string 26 ?=))
+ ;; (encode-coding-region (point-min) (point-max) 'utf-8)
+ (quoted-printable-encode-region (point-min) (point-max) t)
+ (should (equal (buffer-string)
+ (concat "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D"
+ "=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=\n=3D")))))
+
+(ert-deftest qp-test--quoted-printable-encode-string ()
+ (should (equal (quoted-printable-encode-string "\241Hola, se\361or!?")
+ "=A1Hola, se=F1or!?"))
+ ;; Multibyte character.
+ (should-error (quoted-printable-encode-string "å")))
+
+(provide 'qp-tests)
+;;; qp-tests.el ends here
diff --git a/test/lisp/mail/rfc2368-tests.el b/test/lisp/mail/rfc2368-tests.el
new file mode 100644
index 0000000..c35b8e3
--- /dev/null
+++ b/test/lisp/mail/rfc2368-tests.el
@@ -0,0 +1,39 @@
+;;; rfc2368-tests.el --- Tests for rfc2368.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'rfc2368)
+
+(ert-deftest rfc2368-unhexify-string ()
+ (should (equal (rfc2368-unhexify-string "hello%20there") "hello there")))
+
+(ert-deftest rfc2368-parse-mailto-url ()
+ (should (equal (rfc2368-parse-mailto-url
"mailto:foo@example.org?subject=Foo&bar=baz";)
+ '(("To" . "foo@example.org") ("Subject" . "Foo") ("Bar" .
"baz"))))
+ (should (equal (rfc2368-parse-mailto-url
"mailto:foo@bar.com?to=bar@example.org";)
+ '(("To" . "foo@bar.com, bar@example.org"))))
+ (should (equal (rfc2368-parse-mailto-url
"mailto:foo@bar.com?subject=bar%20baz";)
+ '(("To" . "foo@bar.com") ("Subject" . "bar baz")))))
+
+(provide 'rfc2368-tests)
+;;; rfc2368-tests.el ends here
diff --git a/test/lisp/man-tests.el b/test/lisp/man-tests.el
index fba4d74..8267d8e 100644
--- a/test/lisp/man-tests.el
+++ b/test/lisp/man-tests.el
@@ -1,4 +1,4 @@
-;;; man-tests.el --- Test suite for man.
+;;; man-tests.el --- Test suite for man. -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -114,7 +114,7 @@ in the cdr of the element.")
(dolist (test man-tests-parse-man-k-tests)
(should (man-tests-parse-man-k-test-case test))))
-(defun man-tests-filter-strings (buffer strings)
+(defun man-tests-filter-strings (_buffer strings)
"Run `Man-bgproc-filter' on each of STRINGS.
The formatted result will be inserted into BUFFER."
(let ((proc (start-process "dummy man-tests proc" (current-buffer) "cat")))
diff --git a/test/lisp/net/hmac-md5-tests.el b/test/lisp/net/hmac-md5-tests.el
new file mode 100644
index 0000000..30d221e
--- /dev/null
+++ b/test/lisp/net/hmac-md5-tests.el
@@ -0,0 +1,80 @@
+;;; hmac-md5-tests.el --- Tests for hmac-md5.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'hmac-md5)
+
+;; Test cases from RFC 2202, "Test Cases for HMAC-MD5 and HMAC-SHA-1",
+;; moved here from hmac-md5.el
+
+(ert-deftest hmac-md5-test-encode-string ()
+ ;; RFC 2202 -- test_case 1
+ (should (equal (encode-hex-string
+ (hmac-md5 "Hi There" (make-string 16 ?\x0b)))
+ "9294727a3638bb1c13f48ef8158bfc9d"))
+
+ ;; RFC 2202 -- test_case 2
+ (should (equal (encode-hex-string
+ (hmac-md5 "what do ya want for nothing?" "Jefe"))
+ "750c783e6ab0b503eaa86e310a5db738"))
+
+ ;; RFC 2202 -- test_case 3
+ (should (equal (encode-hex-string
+ (hmac-md5 (decode-hex-string (make-string 100 ?d))
+ (decode-hex-string (make-string 32 ?a))))
+ "56be34521d144c88dbb8c733f0e8b3f6"))
+
+ ;; RFC 2202 -- test_case 4
+ (should (equal (encode-hex-string
+ (hmac-md5 (decode-hex-string
+ (mapconcat (lambda (c) (concat (list c) "d"))
+ (make-string 50 ?c) ""))
+ (decode-hex-string
"0102030405060708090a0b0c0d0e0f10111213141516171819")))
+ "697eaf0aca3a3aea3a75164746ffaa79"))
+
+ ;; RFC 2202 -- test_case 5 (a)
+ (should (equal (encode-hex-string
+ (hmac-md5 "Test With Truncation" (make-string 16 ?\x0c)))
+ "56461ef2342edc00f9bab995690efd4c"))
+
+ ;; RFC 2202 -- test_case 5 (b)
+ (should (equal (encode-hex-string
+ (hmac-md5-96 "Test With Truncation" (make-string 16 ?\x0c)))
+ "56461ef2342edc00f9bab995"))
+
+ ;; RFC 2202 -- test_case 6
+ (should (equal (encode-hex-string
+ (hmac-md5
+ "Test Using Larger Than Block-Size Key - Hash Key First"
+ (decode-hex-string (make-string 160 ?a))))
+ "6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"))
+
+ ;; RFC 2202 -- test_case 7
+ (should (equal (encode-hex-string
+ (hmac-md5
+ "Test Using Larger Than Block-Size Key and Larger Than One
Block-Size Data"
+ (decode-hex-string (make-string 160 ?a))))
+ "6f630fad67cda0ee1fb1f562db3aa53e")))
+
+(provide 'hmac-md5-tests)
+;;; hmac-md5-tests.el ends here
diff --git a/test/lisp/net/puny-tests.el b/test/lisp/net/puny-tests.el
index 288bc2f..7dac397 100644
--- a/test/lisp/net/puny-tests.el
+++ b/test/lisp/net/puny-tests.el
@@ -38,4 +38,25 @@
"Test puny decoding."
(should (string= (puny-decode-string "xn--9dbdkw") "חנוך")))
+(ert-deftest puny-test-encode-domain ()
+ (should (string= (puny-encode-domain "åäö.se") "xn--4cab6c.se")))
+
+(ert-deftest puny-test-decode-domain ()
+ (should (string= (puny-decode-domain "xn--4cab6c.se") "åäö.se")))
+
+(ert-deftest puny-highly-restrictive-domain-p ()
+ (should (puny-highly-restrictive-domain-p "foo.bar.org"))
+ (should (puny-highly-restrictive-domain-p "foo.abcåäö.org"))
+ (should (puny-highly-restrictive-domain-p "foo.ர.org"))
+ ;; Disallow unicode character 2044, visually similar to "/".
+ (should-not (puny-highly-restrictive-domain-p
"www.yourbank.com⁄login⁄checkUser.jsp?inxs.ch"))
+ ;; Disallow mixing scripts.
+ (should-not (puny-highly-restrictive-domain-p "åர.org"))
+ ;; Only allowed in moderately restrictive.
+ (should-not (puny-highly-restrictive-domain-p "Teχ.org"))
+ (should-not (puny-highly-restrictive-domain-p "HλLF-LIFE.org"))
+ (should-not (puny-highly-restrictive-domain-p "Ωmega.org"))
+ ;; Only allowed in unrestricted.
+ (should-not (puny-highly-restrictive-domain-p "I♥NY.org")))
+
;;; puny-tests.el ends here
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 75a0167..1f56baa 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -75,6 +75,7 @@
;; Needed for Emacs 26.
(defvar async-shell-command-width)
;; Needed for Emacs 27.
+(defvar process-file-return-signal-string)
(defvar shell-command-dont-erase-buffer)
;; Beautify batch mode.
@@ -4208,6 +4209,28 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(should (zerop (process-file "true")))
(should-not (zerop (process-file "false")))
(should-not (zerop (process-file "binary-does-not-exist")))
+ ;; Return exit code.
+ (should (= 42 (process-file
+ (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
+ nil nil nil "-c" "exit 42")))
+ ;; Return exit code in case the process is interrupted,
+ ;; and there's no indication for a signal describing string.
+ (let (process-file-return-signal-string)
+ (should
+ (= (+ 128 2)
+ (process-file
+ (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
+ nil nil nil "-c" "kill -2 $$"))))
+ ;; Return string in case the process is interrupted and
+ ;; there's an indication for a signal describing string.
+ (let ((process-file-return-signal-string t))
+ (should
+ (string-equal
+ "Interrupt"
+ (process-file
+ (if (tramp--test-adb-p) "/system/bin/sh" "/bin/sh")
+ nil nil nil "-c" "kill -2 $$"))))
+
(with-temp-buffer
(write-region "foo" nil tmp-name)
(should (file-exists-p tmp-name))
@@ -4869,65 +4892,72 @@ INPUT, if non-nil, is a string sent to the process."
(envvar (concat "VAR_" (upcase (md5 (current-time-string)))))
kill-buffer-query-functions)
- (unwind-protect
- ;; Set a value.
- (let ((process-environment
- (cons (concat envvar "=foo") process-environment)))
- ;; Default value.
- (should
- (string-match
- "foo"
- (funcall
- this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))))
-
- (unwind-protect
- ;; Set the empty value.
- (let ((process-environment
- (cons (concat envvar "=") process-environment)))
- ;; Value is null.
- (should
- (string-match
- "bla"
- (funcall
- this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))
- ;; Variable is set.
- (should
- (string-match
- (regexp-quote envvar)
- (funcall this-shell-command-to-string "set")))))
+ ;; Check INSIDE_EMACS.
+ (setenv "INSIDE_EMACS")
+ (should
+ (string-equal
+ (format "%s,tramp:%s" emacs-version tramp-version)
+ (funcall this-shell-command-to-string "echo -n ${INSIDE_EMACS:-bla}")))
+ (let ((process-environment
+ (cons (format "INSIDE_EMACS=%s,foo" emacs-version)
+ process-environment)))
+ (should
+ (string-equal
+ (format "%s,foo,tramp:%s" emacs-version tramp-version)
+ (funcall
+ this-shell-command-to-string "echo -n ${INSIDE_EMACS:-bla}"))))
+
+ ;; Set a value.
+ (let ((process-environment
+ (cons (concat envvar "=foo") process-environment)))
+ ;; Default value.
+ (should
+ (string-match
+ "foo"
+ (funcall
+ this-shell-command-to-string (format "echo -n ${%s:-bla}" envvar)))))
+
+ ;; Set the empty value.
+ (let ((process-environment
+ (cons (concat envvar "=") process-environment)))
+ ;; Value is null.
+ (should
+ (string-match
+ "bla"
+ (funcall
+ this-shell-command-to-string (format "echo -n ${%s:-bla}" envvar))))
+ ;; Variable is set.
+ (should
+ (string-match
+ (regexp-quote envvar)
+ (funcall this-shell-command-to-string "set"))))
;; We force a reconnect, in order to have a clean environment.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- (unwind-protect
- ;; Unset the variable.
- (let ((tramp-remote-process-environment
- (cons (concat envvar "=foo")
- tramp-remote-process-environment)))
- ;; Set the initial value, we want to unset below.
- (should
- (string-match
- "foo"
- (funcall
- this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))
- (let ((process-environment
- (cons envvar process-environment)))
- ;; Variable is unset.
- (should
- (string-match
- "bla"
- (funcall
- this-shell-command-to-string
- (format "echo -n ${%s:-bla}" envvar))))
- ;; Variable is unset.
- (should-not
- (string-match
- (regexp-quote envvar)
- ;; We must remove PS1, the output is truncated otherwise.
- (funcall
- this-shell-command-to-string "printenv | grep -v PS1")))))))))
+ ;; Unset the variable.
+ (let ((tramp-remote-process-environment
+ (cons (concat envvar "=foo") tramp-remote-process-environment)))
+ ;; Set the initial value, we want to unset below.
+ (should
+ (string-match
+ "foo"
+ (funcall
+ this-shell-command-to-string (format "echo -n ${%s:-bla}" envvar))))
+ (let ((process-environment (cons envvar process-environment)))
+ ;; Variable is unset.
+ (should
+ (string-match
+ "bla"
+ (funcall
+ this-shell-command-to-string
+ (format "echo -n ${%s:-bla}" envvar))))
+ ;; Variable is unset.
+ (should-not
+ (string-match
+ (regexp-quote envvar)
+ ;; We must remove PS1, the output is truncated otherwise.
+ (funcall
+ this-shell-command-to-string "printenv | grep -v PS1"))))))))
;; This test is inspired by Bug#27009.
(ert-deftest tramp-test33-environment-variables-and-port-numbers ()
diff --git a/test/lisp/net/webjump-tests.el b/test/lisp/net/webjump-tests.el
new file mode 100644
index 0000000..47569c9
--- /dev/null
+++ b/test/lisp/net/webjump-tests.el
@@ -0,0 +1,73 @@
+;;; webjump-tests.el --- Tests for webjump.el -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'webjump)
+
+(ert-deftest webjump-tests-builtin ()
+ (should (equal (webjump-builtin '[name] "gnu.org") "gnu.org")))
+
+(ert-deftest webjump-tests-builtin-check-args ()
+ (should (webjump-builtin-check-args [1 2 3] "Foo" 2))
+ (should-error (webjump-builtin-check-args [1 2 3] "Foo" 3)))
+
+(ert-deftest webjump-tests-mirror-default ()
+ (should (equal (webjump-mirror-default
+ '("https://ftp.gnu.org/pub/gnu/";
+ "https://ftpmirror.gnu.org";))
+ "https://ftp.gnu.org/pub/gnu/";)))
+
+(ert-deftest webjump-tests-null-or-blank-string-p ()
+ (should (webjump-null-or-blank-string-p nil))
+ (should (webjump-null-or-blank-string-p ""))
+ (should (webjump-null-or-blank-string-p " "))
+ (should-not (webjump-null-or-blank-string-p " . ")))
+
+(ert-deftest webjump-tests-url-encode ()
+ (should (equal (webjump-url-encode "") ""))
+ (should (equal (webjump-url-encode "a b c") "a+b+c"))
+ (should (equal (webjump-url-encode "foo?") "foo%3F"))
+ (should (equal (webjump-url-encode "/foo\\") "/foo%5C"))
+ (should (equal (webjump-url-encode "f&o") "f%26o")))
+
+(ert-deftest webjump-tests-url-fix ()
+ (should (equal (webjump-url-fix nil) ""))
+ (should (equal (webjump-url-fix "/tmp/") "file:///tmp/"))
+ (should (equal (webjump-url-fix "gnu.org") "http://gnu.org/";))
+ (should (equal (webjump-url-fix "ftp.x.org") "ftp://ftp.x.org/";))
+ (should (equal (webjump-url-fix "https://gnu.org";)
+ "https://gnu.org/";)))
+
+(ert-deftest webjump-tests-url-fix-trailing-slash ()
+ (should (equal (webjump-url-fix-trailing-slash "https://gnu.org";)
+ "https://gnu.org/";))
+ (should (equal (webjump-url-fix-trailing-slash "https://gnu.org/";)
+ "https://gnu.org/";)))
+
+(provide 'webjump-tests)
+;;; webjump-tests.el ends here
diff --git a/test/lisp/password-cache-tests.el
b/test/lisp/password-cache-tests.el
index 01f4358..55ebbfc 100644
--- a/test/lisp/password-cache-tests.el
+++ b/test/lisp/password-cache-tests.el
@@ -28,31 +28,31 @@
(ert-deftest password-cache-tests-add-and-remove ()
(let ((password-data (copy-hash-table password-data)))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(should (eq (password-in-cache-p "foo") t))
(password-cache-remove "foo")
(should (not (password-in-cache-p "foo")))))
(ert-deftest password-cache-tests-read-from-cache ()
(let ((password-data (copy-hash-table password-data)))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(should (equal (password-read-from-cache "foo") "bar"))
(should (not (password-read-from-cache nil)))))
(ert-deftest password-cache-tests-in-cache-p ()
(let ((password-data (copy-hash-table password-data)))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(should (password-in-cache-p "foo"))
(should (not (password-read-from-cache nil)))))
(ert-deftest password-cache-tests-read ()
(let ((password-data (copy-hash-table password-data)))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(should (equal (password-read nil "foo") "bar"))))
(ert-deftest password-cache-tests-reset ()
(let ((password-data (copy-hash-table password-data)))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(password-reset)
(should (not (password-in-cache-p "foo")))))
@@ -60,14 +60,14 @@
:tags '(:expensive-test)
(let ((password-data (copy-hash-table password-data))
(password-cache-expiry 0.01))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(sit-for 0.1)
(should (not (password-in-cache-p "foo")))))
(ert-deftest password-cache-tests-no-password-cache ()
(let ((password-data (copy-hash-table password-data))
(password-cache nil))
- (password-cache-add "foo" "bar")
+ (password-cache-add "foo" (copy-sequence "bar"))
(should (not (password-in-cache-p "foo")))
(should (not (password-read-from-cache "foo")))))
diff --git a/test/lisp/play/animate-tests.el b/test/lisp/play/animate-tests.el
new file mode 100644
index 0000000..8af1517
--- /dev/null
+++ b/test/lisp/play/animate-tests.el
@@ -0,0 +1,56 @@
+;;; animate-tests.el --- Tests for animate.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+(require 'animate)
+
+(ert-deftest animate-test-birthday-present ()
+ (unwind-protect
+ (save-window-excursion
+ (cl-letf (((symbol-function 'sit-for) (lambda (_) nil)))
+ (animate-birthday-present "foo")
+ (should (equal (buffer-string)
+ "
+
+
+
+
+
+Happy Birthday,
+ Foo
+
+
+ You are my sunshine,
+ My only sunshine.
+ I'm awful sad that
+ You've moved away.
+
+ Let's talk together
+ And love more deeply.
+ Please bring back
+ my sunshine
+ to stay!"))))
+ (kill-buffer "*A-Present-for-Foo*")))
+
+(provide 'animate-tests)
+;;; animate-tests.el ends here
diff --git
a/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
b/test/lisp/play/dissociate-tests.el
similarity index 51%
copy from
test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
copy to test/lisp/play/dissociate-tests.el
index ab638ef..e8d9031 100644
--- a/test/lisp/emacs-lisp/faceup-resources/faceup-test-this-file-directory.el
+++ b/test/lisp/play/dissociate-tests.el
@@ -1,9 +1,6 @@
-;;; faceup-test-this-file-directory.el --- Support file for faceup tests
+;;; dissociate-tests.el --- Tests for dissociate.el -*- lexical-binding:t -*-
-;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
-
-;; Author: Anders Lindgren
-;; Keywords: languages, faces
+;; Copyright (C) 2020 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -22,11 +19,20 @@
;;; Commentary:
-;; Support file for `faceup-test-basics.el'. This file is used to test
-;; `faceup-this-file-directory' in various contexts.
-
;;; Code:
-(defvar faceup-test-this-file-directory (faceup-this-file-directory))
-
-;;; faceup-test-this-file-directory.el ends here
+(require 'ert)
+(require 'dissociate)
+
+(ert-deftest dissociate-tests-dissociated-press ()
+ (cl-letf (((symbol-function 'y-or-n-p) (lambda (_) nil))
+ ((symbol-function 'random) (lambda (_) 10)))
+ (save-window-excursion
+ (with-temp-buffer
+ (insert "Lorem ipsum dolor sit amet")
+ (dissociated-press)
+ (should (string-match-p "dolor sit ametdolor sit amdolor sit amdolor
sit am"
+ (buffer-string)))))))
+
+(provide 'dissociate-tests)
+;;; dissociate-tests.el ends here
diff --git a/test/lisp/progmodes/autoconf-tests.el
b/test/lisp/progmodes/autoconf-tests.el
new file mode 100644
index 0000000..63cf288
--- /dev/null
+++ b/test/lisp/progmodes/autoconf-tests.el
@@ -0,0 +1,55 @@
+;;; autoconf-tests.el --- Tests for autoconf.el -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'autoconf)
+(require 'ert)
+
+(ert-deftest autoconf-tests-current-defun-function-define ()
+ (with-temp-buffer
+ (insert "AC_DEFINE(HAVE_RSVG, 1, [Define to 1 if using librsvg.])")
+ (goto-char (point-min))
+ (should-not (autoconf-current-defun-function))
+ (forward-char 10)
+ (should (equal (autoconf-current-defun-function) "HAVE_RSVG"))))
+
+(ert-deftest autoconf-tests-current-defun-function-subst ()
+ (with-temp-buffer
+ (insert "AC_SUBST(srcdir)")
+ (goto-char (point-min))
+ (should-not (autoconf-current-defun-function))
+ (forward-char 9)
+ (should (equal (autoconf-current-defun-function) "srcdir"))))
+
+(ert-deftest autoconf-tests-autoconf-mode-comment-syntax ()
+ (with-temp-buffer
+ (autoconf-mode)
+ (insert "dnl Autoconf script for GNU Emacs")
+ (should (nth 4 (syntax-ppss)))))
+
+(provide 'autoconf-tests)
+;;; autoconf-tests.el ends here
diff --git a/test/lisp/progmodes/cc-mode-tests.el
b/test/lisp/progmodes/cc-mode-tests.el
index 0729841..64d52a9 100644
--- a/test/lisp/progmodes/cc-mode-tests.el
+++ b/test/lisp/progmodes/cc-mode-tests.el
@@ -40,7 +40,7 @@
(insert content)
(setq mode nil)
(c-or-c++-mode)
- (unless(eq expected mode)
+ (unless (eq expected mode)
(ert-fail
(format "expected %s but got %s when testing '%s'"
expected mode content)))))
@@ -53,11 +53,18 @@
(funcall do-test (concat " * " content) 'c-mode))
'("using \t namespace \t std;"
"using \t std::string;"
+ "using Foo = Bar;"
"namespace \t {"
"namespace \t foo \t {"
- "class \t Blah_42 \t {"
+ "namespace \t foo::bar \t {"
+ "inline namespace \t foo \t {"
+ "inline namespace \t foo::bar \t {"
"class \t Blah_42 \t \n"
+ "class \t Blah_42;"
+ "class \t Blah_42 \t final {"
+ "struct \t Blah_42 \t final {"
"class \t _42_Blah:public Foo {"
+ "struct \t _42_Blah:public Foo {"
"template \t < class T >"
"template< class T >"
"#include <string>"
@@ -67,6 +74,7 @@
(mapc (lambda (content) (funcall do-test content 'c-mode))
'("struct \t Blah_42 \t {"
"struct template {"
+ "struct Blah;"
"#include <string.h>")))))
(ert-deftest c-mode-macro-comment ()
@@ -78,4 +86,25 @@
(insert macro-string)
(c-mode))))
+(ert-deftest c-lineup-ternary-bodies ()
+ "Test for c-lineup-ternary-bodies function"
+ (with-temp-buffer
+ (c-mode)
+ (let* ((common-prefix "int value = condition ")
+ (expected-column (length common-prefix)))
+ (dolist (test '(("? a : \n b" . nil)
+ ("? a \n ::b" . nil)
+ ("a \n : b" . nil)
+ ("? a \n : b" . t)
+ ("? ::a \n : b" . t)
+ ("? (p ? q : r) \n : b" . t)
+ ("? p ?: q \n : b" . t)
+ ("? p ? : q \n : b" . t)
+ ("? p ? q : r \n : b" . t)))
+ (delete-region (point-min) (point-max))
+ (insert common-prefix (car test))
+ (should (equal
+ (and (cdr test) (vector expected-column))
+ (c-lineup-ternary-bodies '(statement-cont . 1))))))))
+
;;; cc-mode-tests.el ends here
diff --git a/test/lisp/progmodes/etags-tests.el
b/test/lisp/progmodes/etags-tests.el
index f7a5ac4..79368cd 100644
--- a/test/lisp/progmodes/etags-tests.el
+++ b/test/lisp/progmodes/etags-tests.el
@@ -1,4 +1,4 @@
-;;; etags-tests.el --- Test suite for etags.el.
+;;; etags-tests.el --- Test suite for etags.el. -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/progmodes/f90-tests.el b/test/lisp/progmodes/f90-tests.el
index b6fbac3..5115f8e 100644
--- a/test/lisp/progmodes/f90-tests.el
+++ b/test/lisp/progmodes/f90-tests.el
@@ -1,4 +1,4 @@
-;;; f90-tests.el --- tests for progmodes/f90.el
+;;; f90-tests.el --- tests for progmodes/f90.el -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/progmodes/glasses-tests.el
b/test/lisp/progmodes/glasses-tests.el
new file mode 100644
index 0000000..277a9cc
--- /dev/null
+++ b/test/lisp/progmodes/glasses-tests.el
@@ -0,0 +1,101 @@
+;;; glasses-tests.el --- Tests for glasses.el -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Simen Heggestøyl <simenheg@gmail.com>
+;; Keywords:
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'glasses)
+(require 'seq)
+
+(ert-deftest glasses-tests-parenthesis-exception-p ()
+ (with-temp-buffer
+ (insert "public OnClickListener menuListener() {}")
+ (let ((glasses-separate-parentheses-exceptions '("^Listen")))
+ (should-not (glasses-parenthesis-exception-p 1 (point-max)))
+ (should (glasses-parenthesis-exception-p 15 (point-max)))
+ (should-not (glasses-parenthesis-exception-p 24 (point-max)))
+ (should (glasses-parenthesis-exception-p 28 (point-max))))))
+
+(ert-deftest glasses-tests-overlay-p ()
+ (should
+ (glasses-overlay-p (glasses-make-overlay (point-min) (point-max))))
+ (should-not
+ (glasses-overlay-p (make-overlay (point-min) (point-max)))))
+
+(ert-deftest glasses-tests-make-overlay-p ()
+ (let ((o (glasses-make-overlay (point-min) (point-max))))
+ (should (eq (overlay-get o 'category) 'glasses)))
+ (let ((o (glasses-make-overlay (point-min) (point-max) 'foo)))
+ (should (eq (overlay-get o 'category) 'foo))))
+
+(ert-deftest glasses-tests-make-readable ()
+ (with-temp-buffer
+ (insert "pp.setBackgroundResource(R.drawable.button_right);")
+ (glasses-make-readable (point-min) (point-max))
+ (pcase-let ((`(,o1 ,o2 ,o3)
+ (sort (overlays-in (point-min) (point-max))
+ (lambda (o1 o2)
+ (< (overlay-start o1) (overlay-start o2))))))
+ (should (= (overlay-start o1) 7))
+ (should (equal (overlay-get o1 'before-string)
+ glasses-separator))
+ (should (= (overlay-start o2) 17))
+ (should (equal (overlay-get o2 'before-string)
+ glasses-separator))
+ (should (= (overlay-start o3) 25))
+ (should (equal (overlay-get o3 'before-string) " ")))))
+
+(ert-deftest glasses-tests-make-readable-dont-separate-parentheses ()
+ (with-temp-buffer
+ (insert "pp.setBackgroundResource(R.drawable.button_right);")
+ (let ((glasses-separate-parentheses-p nil))
+ (glasses-make-readable (point-min) (point-max))
+ (should-not (overlays-at 25)))))
+
+(ert-deftest glasses-tests-make-unreadable ()
+ (with-temp-buffer
+ (insert "pp.setBackgroundResource(R.drawable.button_right);")
+ (glasses-make-readable (point-min) (point-max))
+ (should (seq-some #'glasses-overlay-p
+ (overlays-in (point-min) (point-max))))
+ (glasses-make-unreadable (point-min) (point-max))
+ (should-not (seq-some #'glasses-overlay-p
+ (overlays-in (point-min) (point-max))))))
+
+(ert-deftest glasses-tests-convert-to-unreadable ()
+ (with-temp-buffer
+ (insert "set_Background_Resource(R.button_right);")
+ (let ((glasses-convert-on-write-p nil))
+ (should-not (glasses-convert-to-unreadable))
+ (should (equal (buffer-string)
+ "set_Background_Resource(R.button_right);")))
+ (let ((glasses-convert-on-write-p t))
+ (should-not (glasses-convert-to-unreadable))
+ (should (equal (buffer-string)
+ "setBackgroundResource(R.button_right);")))))
+
+(provide 'glasses-tests)
+;;; glasses-tests.el ends here
diff --git a/test/lisp/progmodes/ps-mode-tests.el
b/test/lisp/progmodes/ps-mode-tests.el
index a47abeb..d565b32 100644
--- a/test/lisp/progmodes/ps-mode-tests.el
+++ b/test/lisp/progmodes/ps-mode-tests.el
@@ -1,4 +1,4 @@
-;;; ps-mode-tests.el --- Test suite for ps-mode
+;;; ps-mode-tests.el --- Test suite for ps-mode -*- lexical-binding:t -*-
;; Copyright (C) 2019-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index 65a60b4..60cd6ea 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -1,4 +1,4 @@
-;;; python-tests.el --- Test suite for python.el
+;;; python-tests.el --- Test suite for python.el -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -118,7 +118,6 @@ Argument MIN and MAX delimit the region to be returned and
default to `point-min' and `point-max' respectively."
(let* ((min (or min (point-min)))
(max (or max (point-max)))
- (buffer (current-buffer))
(buffer-contents (buffer-substring-no-properties min max))
(overlays
(sort (overlays-in min max)
@@ -154,7 +153,7 @@ The name of this directory depends on `system-type'."
sed do eiusmod tempor incididunt ut labore et dolore magna
aliqua."
(let ((expected (save-excursion
- (dotimes (i 3)
+ (dotimes (_ 3)
(re-search-forward "et" nil t))
(forward-char -2)
(point))))
@@ -163,7 +162,7 @@ aliqua."
;; one should be returned.
(should (= (python-tests-look-at "et" 6 t) expected))
;; If already looking at STRING, it should skip it.
- (dotimes (i 2) (re-search-forward "et"))
+ (dotimes (_ 2) (re-search-forward "et"))
(forward-char -2)
(should (= (python-tests-look-at "et") expected)))))
@@ -178,7 +177,7 @@ aliqua."
(re-search-forward "et" nil t)
(forward-char -2)
(point))))
- (dotimes (i 3)
+ (dotimes (_ 3)
(re-search-forward "et" nil t))
(should (= (python-tests-look-at "et" -3 t) expected))
(should (= (python-tests-look-at "et" -6 t) expected)))))
@@ -2642,7 +2641,7 @@ if x:
(ert-deftest python-shell-calculate-process-environment-2 ()
"Test `python-shell-extra-pythonpaths' modification."
(let* ((process-environment process-environment)
- (original-pythonpath (setenv "PYTHONPATH" "/path0"))
+ (_original-pythonpath (setenv "PYTHONPATH" "/path0"))
(python-shell-extra-pythonpaths '("/path1" "/path2"))
(process-environment (python-shell-calculate-process-environment)))
(should (equal (getenv "PYTHONPATH")
diff --git a/test/lisp/progmodes/ruby-mode-tests.el
b/test/lisp/progmodes/ruby-mode-tests.el
index 6bdc765..9d677a2 100644
--- a/test/lisp/progmodes/ruby-mode-tests.el
+++ b/test/lisp/progmodes/ruby-mode-tests.el
@@ -1,4 +1,4 @@
-;;; ruby-mode-tests.el --- Test suite for ruby-mode
+;;; ruby-mode-tests.el --- Test suite for ruby-mode -*- lexical-binding:t -*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/progmodes/subword-tests.el
b/test/lisp/progmodes/subword-tests.el
index 00168c0..86e905c 100644
--- a/test/lisp/progmodes/subword-tests.el
+++ b/test/lisp/progmodes/subword-tests.el
@@ -1,4 +1,4 @@
-;;; subword-tests.el --- Testing the subword rules
+;;; subword-tests.el --- Testing the subword rules -*- lexical-binding:t -*-
;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/progmodes/tcl-tests.el b/test/lisp/progmodes/tcl-tests.el
index 75409a6..fb5a19d 100644
--- a/test/lisp/progmodes/tcl-tests.el
+++ b/test/lisp/progmodes/tcl-tests.el
@@ -1,4 +1,4 @@
-;;; tcl-tests.el --- Test suite for tcl-mode
+;;; tcl-tests.el --- Test suite for tcl-mode -*- lexical-binding:t -*-
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/progmodes/xref-tests.el
b/test/lisp/progmodes/xref-tests.el
index 9c7a9e6..a4980b2 100644
--- a/test/lisp/progmodes/xref-tests.el
+++ b/test/lisp/progmodes/xref-tests.el
@@ -1,4 +1,4 @@
-;;; xref-tests.el --- tests for xref
+;;; xref-tests.el --- tests for xref -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el
index af765fb..f5cff92 100644
--- a/test/lisp/replace-tests.el
+++ b/test/lisp/replace-tests.el
@@ -1,4 +1,4 @@
-;;; replace-tests.el --- tests for replace.el.
+;;; replace-tests.el --- tests for replace.el. -*- lexical-binding:t -*-
;; Copyright (C) 2010-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/shadowfile-tests.el b/test/lisp/shadowfile-tests.el
index ed23e06..03c62de 100644
--- a/test/lisp/shadowfile-tests.el
+++ b/test/lisp/shadowfile-tests.el
@@ -1,4 +1,4 @@
-;;; shadowfile-tests.el --- Tests of shadowfile
+;;; shadowfile-tests.el --- Tests of shadowfile -*- lexical-binding:t -*-
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
@@ -138,9 +138,9 @@ guaranteed by the originator of a cluster definition."
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
(cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest args) (pop mocked-input)))
+ (lambda (&rest _args) (pop mocked-input)))
((symbol-function #'read-string)
- (lambda (&rest args) (pop mocked-input))))
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
@@ -255,9 +255,9 @@ guaranteed by the originator of a cluster definition."
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
(cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest args) (pop mocked-input)))
+ (lambda (&rest _args) (pop mocked-input)))
((symbol-function #'read-string)
- (lambda (&rest args) (pop mocked-input))))
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
@@ -608,9 +608,9 @@ guaranteed by the originator of a cluster definition."
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
(cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest args) (pop mocked-input)))
+ (lambda (&rest _args) (pop mocked-input)))
((symbol-function #'read-string)
- (lambda (&rest args) (pop mocked-input))))
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
@@ -669,9 +669,9 @@ guaranteed by the originator of a cluster definition."
;; We must mock `read-from-minibuffer' and `read-string', in
;; order to avoid interactive arguments.
(cl-letf* (((symbol-function #'read-from-minibuffer)
- (lambda (&rest args) (pop mocked-input)))
+ (lambda (&rest _args) (pop mocked-input)))
((symbol-function #'read-string)
- (lambda (&rest args) (pop mocked-input))))
+ (lambda (&rest _args) (pop mocked-input))))
;; Cleanup & initialize.
(shadow--tests-cleanup)
@@ -923,7 +923,7 @@ guaranteed by the originator of a cluster definition."
;; action.
(add-function
:before (symbol-function #'write-region)
- (lambda (&rest args)
+ (lambda (&rest _args)
(when (and (buffer-file-name) mocked-input)
(should (equal (buffer-file-name) (pop mocked-input)))))
'((name . "write-region-mock")))
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index fa71e26..88be74f 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -757,7 +757,7 @@ See Bug#21722."
;;; Tests for shell-command-dont-erase-buffer
(defmacro with-shell-command-dont-erase-buffer (str output-buffer-is-current
&rest body)
- (declare (debug (form &body)) (indent 2))
+ (declare (debug (sexp form body)) (indent 2))
(let ((expected (make-symbol "expected"))
(command (make-symbol "command"))
(caller-buf (make-symbol "caller-buf"))
@@ -766,8 +766,9 @@ See Bug#21722."
(,output-buf (if ,output-buffer-is-current ,caller-buf
(generate-new-buffer "output-buf")))
(emacs (expand-file-name invocation-name invocation-directory))
- (,command (format "%s -Q --batch --eval \"(princ \\\"%s\\\")\""
- emacs ,str))
+ (,command
+ (format "%s -Q --batch --eval %s"
+ emacs (shell-quote-argument (format "(princ %S)" ,str))))
(inhibit-message t))
(unwind-protect
;; Feature must work the same regardless how we specify the 2nd arg
of `shell-command', ie,
@@ -787,7 +788,7 @@ See Bug#21722."
(ert-deftest simple-tests-shell-command-39067 ()
"The output buffer is erased or not according to
`shell-command-dont-erase-buffer'."
- (let ((str "foo\n"))
+ (let ((str "foo\\n"))
(dolist (output-current '(t nil))
(with-shell-command-dont-erase-buffer str output-current
(let ((expected (cond ((eq shell-command-dont-erase-buffer 'erase) str)
@@ -799,7 +800,7 @@ See Bug#21722."
(ert-deftest simple-tests-shell-command-dont-erase-buffer ()
"The point is set at the expected position after execution of the command."
- (let* ((str "foo\n")
+ (let* ((str "foo\\n")
(expected-point `((beg-last-out . ,(1+ (length str)))
(end-last-out . ,(1+ (* 2 (length str))))
(save-point . 1))))
diff --git a/test/lisp/startup-tests.el b/test/lisp/startup-tests.el
new file mode 100644
index 0000000..314ffc9
--- /dev/null
+++ b/test/lisp/startup-tests.el
@@ -0,0 +1,47 @@
+;;; startup-tests.el --- unit tests for startup.el -*- lexical-binding: t;
-*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Philipp Stephani <phst@google.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Unit tests for startup.el.
+
+;;; Code:
+
+(ert-deftest startup-tests/command-switch-alist ()
+ (let* ((foo-args ()) (bar-args ())
+ (command-switch-alist
+ (list (cons "--foo"
+ (lambda (arg)
+ (ert-info ("Processing argument --foo")
+ (push arg foo-args)
+ (should (equal command-line-args-left
+ '("value" "--bar=value")))
+ (pop command-line-args-left))))
+ (cons "--bar=value"
+ (lambda (arg)
+ (ert-info ("Processing argument --bar")
+ (push arg bar-args)
+ (should-not command-line-args-left)))))))
+ (command-line-1 '("--foo" "value" "--bar=value"))
+ (should (equal foo-args '("--foo")))
+ (should (equal bar-args '("--bar=value")))))
+
+;;; startup-tests.el ends here
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index a583d57..e2761a9 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1,4 +1,4 @@
-;;; subr-tests.el --- Tests for subr.el
+;;; subr-tests.el --- Tests for subr.el -*- lexical-binding:t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el
index bc41b86..f05389d 100644
--- a/test/lisp/tar-mode-tests.el
+++ b/test/lisp/tar-mode-tests.el
@@ -29,7 +29,8 @@
(cons 420 "rw-r--r--")
(cons 292 "r--r--r--")
(cons 512 "--------T")
- (cons 1024 "-----S---"))))
+ (cons 1024 "-----S---")
+ (cons 2048 "--S------"))))
(dolist (x alist)
(should (equal (cdr x) (tar-grind-file-mode (car x)))))))
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index 4edf75e..f02aeae 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -1,4 +1,4 @@
-;;; thingatpt.el --- tests for thing-at-point.
+;;; thingatpt.el --- tests for thing-at-point. -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/vc/add-log-tests.el b/test/lisp/vc/add-log-tests.el
index fc928b0..f256945 100644
--- a/test/lisp/vc/add-log-tests.el
+++ b/test/lisp/vc/add-log-tests.el
@@ -1,4 +1,4 @@
-;;; add-log-tests.el --- Test suite for add-log.
+;;; add-log-tests.el --- Test suite for add-log. -*- lexical-binding:t -*-
;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
@@ -25,12 +25,12 @@
(require 'ert)
(require 'add-log)
-(defmacro add-log-current-defun-deftest (name doc major-mode
+(defmacro add-log-current-defun-deftest (name doc mode
content marker expected-defun)
"Generate an ert test for mode-own `add-log-current-defun-function'.
-Run `add-log-current-defun' at the point where MARKER specifies in a
-buffer which content is CONTENT under MAJOR-MODE. Then it compares the
-result with EXPECTED-DEFUN."
+Run `add-log-current-defun' at the point where MARKER specifies
+in a buffer which content is CONTENT under major mode MODE. Then
+it compares the result with EXPECTED-DEFUN."
(let ((xname (intern (concat "add-log-current-defun-test-"
(symbol-name name)
))))
@@ -39,7 +39,7 @@ result with EXPECTED-DEFUN."
(with-temp-buffer
(insert ,content)
(goto-char (point-min))
- (funcall ',major-mode)
+ (funcall ',mode)
(should (equal (when (search-forward ,marker nil t)
(replace-match "" nil t)
(add-log-current-defun))
diff --git a/test/lisp/vc/diff-mode-tests.el b/test/lisp/vc/diff-mode-tests.el
index 26e9f26..e497ed2 100644
--- a/test/lisp/vc/diff-mode-tests.el
+++ b/test/lisp/vc/diff-mode-tests.el
@@ -1,3 +1,5 @@
+;;; diff-mode-tests.el --- Tests for diff-mode.el -*- lexical-binding:t -*-
+
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
;; Author: Dima Kogan <dima@secretsauce.net>
diff --git a/test/lisp/vc/ediff-ptch-tests.el b/test/lisp/vc/ediff-ptch-tests.el
index ab44e23..a3a592b 100644
--- a/test/lisp/vc/ediff-ptch-tests.el
+++ b/test/lisp/vc/ediff-ptch-tests.el
@@ -1,4 +1,4 @@
-;;; ediff-ptch-tests.el --- Tests for ediff-ptch.el
+;;; ediff-ptch-tests.el --- Tests for ediff-ptch.el -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/vc/smerge-mode-tests.el
b/test/lisp/vc/smerge-mode-tests.el
index c76fc17..5b15a09 100644
--- a/test/lisp/vc/smerge-mode-tests.el
+++ b/test/lisp/vc/smerge-mode-tests.el
@@ -1,3 +1,5 @@
+;;; smerge-mode-tests.el --- Tests for smerge-mode.el -*- lexical-binding:t
-*-
+
;; Copyright (C) 2017-2020 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
diff --git a/test/lisp/vc/vc-hg-tests.el b/test/lisp/vc/vc-hg-tests.el
index 01d1975..e4a20bb 100644
--- a/test/lisp/vc/vc-hg-tests.el
+++ b/test/lisp/vc/vc-hg-tests.el
@@ -1,4 +1,4 @@
-;;; vc-hg-tests.el --- tests for vc/vc-hg.el
+;;; vc-hg-tests.el --- tests for vc/vc-hg.el -*- lexical-binding:t -*-
;; Copyright (C) 2016-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index 43d2448..ff85e2f 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -1,4 +1,4 @@
-;;; vc-tests.el --- Tests of different backends of vc.el
+;;; vc-tests.el --- Tests of different backends of vc.el -*-
lexical-binding:t -*-
;; Copyright (C) 2014-2020 Free Software Foundation, Inc.
diff --git a/test/lisp/gnus/gnus-tests.el b/test/lisp/version-tests.el
similarity index 62%
copy from test/lisp/gnus/gnus-tests.el
copy to test/lisp/version-tests.el
index d18b3fb..8fbd4a1 100644
--- a/test/lisp/gnus/gnus-tests.el
+++ b/test/lisp/version-tests.el
@@ -1,8 +1,6 @@
-;;; gnus-tests.el --- Wrapper for the Gnus tests
+;;; version-tests.el --- Tests for version.el -*- lexical-binding: t -*-
-;; Copyright (C) 2011-2020 Free Software Foundation, Inc.
-
-;; Author: Teodor Zlatanov <tzz@lifelogs.com>
+;; Copyright (C) 2020 Free Software Foundation, Inc.
;; This file is part of GNU Emacs.
@@ -21,13 +19,13 @@
;;; Commentary:
-;; This file should contain nothing but requires for all the Gnus
-;; tests that are not standalone.
-
;;; Code:
-;; registry.el is required by gnus-registry.el but this way we're explicit.
-(require 'registry)
-(require 'gnus-registry)
-(provide 'gnus-tests)
-;;; gnus-tests.el ends here
+(require 'ert)
+
+(ert-deftest test-emacs-version ()
+ (should (string-match emacs-version (emacs-version)))
+ (should (string-match system-configuration (emacs-version))))
+
+(provide 'version-tests)
+;;; version-tests.el ends here
diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el
index 895b68f..72c78d0 100644
--- a/test/lisp/xml-tests.el
+++ b/test/lisp/xml-tests.el
@@ -1,4 +1,4 @@
-;;; xml-parse-tests.el --- Test suite for XML parsing.
+;;; xml-parse-tests.el --- Test suite for XML parsing. -*- lexical-binding:t
-*-
;; Copyright (C) 2012-2020 Free Software Foundation, Inc.
@@ -164,6 +164,16 @@ Parser is called with and without 'symbol-qnames
argument.")
(should (equal (cdr xml-parse-test--namespace-attribute-qnames)
(xml-parse-region nil nil nil nil 'symbol-qnames)))))
+(ert-deftest xml-print-invalid-cdata ()
+ "Check that Bug#41094 is fixed."
+ (with-temp-buffer
+ (should (equal (should-error (xml-print '((foo () "\0")))
+ :type 'xml-invalid-character)
+ '(xml-invalid-character 0 1)))
+ (should (equal (should-error (xml-print '((foo () "\u00FF \xFF")))
+ :type 'xml-invalid-character)
+ '(xml-invalid-character #x3FFFFF 3)))))
+
;; Local Variables:
;; no-byte-compile: t
;; End:
diff --git a/test/manual/indent/css-mode.css b/test/manual/indent/css-mode.css
index ecf6c3c..041aeec 100644
--- a/test/manual/indent/css-mode.css
+++ b/test/manual/indent/css-mode.css
@@ -92,5 +92,9 @@ div::before {
.foo-bar--baz {
--foo-variable: 5px;
+ --_variable_with_underscores: #fff;
+ --_variable-starting-with-underscore: none;
margin: var(--foo-variable);
+ color: var(--_variable_with_underscores);
+ display: var(--_variable-starting-with-underscore);
}
diff --git a/test/manual/indent/less-css-mode.less
b/test/manual/indent/less-css-mode.less
index 36c0374..b40a236 100644
--- a/test/manual/indent/less-css-mode.less
+++ b/test/manual/indent/less-css-mode.less
@@ -1,3 +1,13 @@
+@var-with-dashes: #428bca;
+@var_with_underscores: 10px;
+@_var-starting-with-underscore: none;
+
+body {
+ background: @var-with-dashes;
+ padding: @var_with_underscores;
+ display: @_var-starting-with-underscore;
+}
+
.desktop-and-old-ie(@rules) {
@media screen and (min-width: 1200) { @rules(); }
html.lt-ie9 & { @rules(); }
diff --git a/test/manual/indent/scss-mode.scss
b/test/manual/indent/scss-mode.scss
index a3dd41e..189ec4e 100644
--- a/test/manual/indent/scss-mode.scss
+++ b/test/manual/indent/scss-mode.scss
@@ -41,9 +41,13 @@ p.#{$name} var
article[role="main"] {
$toto: 500 !global;
$var-with-default: 300 !default;
+ $var_with_underscores: #fff;
+ $_var-starting-with-underscore: none;
float: left !important;
width: 600px / 888px * 100%;
height: 100px / 888px * 100%;
+ color: $var_with_underscores;
+ display: $_var-starting-with-underscore;
}
%placeholder {
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 6e87cb9..6e97646 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -1327,4 +1327,10 @@ with parameters from the *Messages* buffer modification."
(set-buffer-multibyte t)
(buffer-string)))))))
+;; https://debbugs.gnu.org/33492
+(ert-deftest buffer-tests-buffer-local-variables-undo ()
+ "Test that `buffer-undo-list' appears in `buffer-local-variables'."
+ (with-temp-buffer
+ (should (assq 'buffer-undo-list (buffer-local-variables)))))
+
;;; buffer-tests.el ends here
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index c6ceae4..b65543a 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -49,21 +49,21 @@
(should-error (nreverse))
(should-error (nreverse 1))
(should-error (nreverse (make-char-table 'foo)))
- (should (equal (nreverse "xyzzy") "yzzyx"))
- (let ((A []))
+ (should (equal (nreverse (copy-sequence "xyzzy")) "yzzyx"))
+ (let ((A (vector)))
(nreverse A)
(should (equal A [])))
- (let ((A [0]))
+ (let ((A (vector 0)))
(nreverse A)
(should (equal A [0])))
- (let ((A [1 2 3 4]))
+ (let ((A (vector 1 2 3 4)))
(nreverse A)
(should (equal A [4 3 2 1])))
- (let ((A [1 2 3 4]))
+ (let ((A (vector 1 2 3 4)))
(nreverse A)
(nreverse A)
(should (equal A [1 2 3 4])))
- (let* ((A [1 2 3 4])
+ (let* ((A (vector 1 2 3 4))
(B (nreverse (nreverse A))))
(should (equal A B))))
@@ -146,13 +146,13 @@
;; Invalid UTF-8 sequences shall be indicated. How to create such strings?
(ert-deftest fns-tests-sort ()
- (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
+ (should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
'(-1 2 3 4 5 5 7 8 9)))
- (should (equal (sort '(9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
+ (should (equal (sort (list 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
'(9 8 7 5 5 4 3 2 -1)))
- (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (< x y)))
+ (should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (< x y)))
[-1 2 3 4 5 5 7 8 9]))
- (should (equal (sort '[9 5 2 -1 5 3 8 7 4] (lambda (x y) (> x y)))
+ (should (equal (sort (vector 9 5 2 -1 5 3 8 7 4) (lambda (x y) (> x y)))
[9 8 7 5 5 4 3 2 -1]))
(should (equal
(sort
@@ -172,7 +172,7 @@
;; Punctuation and whitespace characters are relevant for POSIX.
(should
(equal
- (sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
+ (sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b) (string-collate-lessp a b "POSIX")))
'("1 1" "1 2" "1.1" "1.2" "11" "12")))
;; Punctuation and whitespace characters are not taken into account
@@ -180,7 +180,7 @@
(when (eq system-type 'windows-nt)
(should
(equal
- (sort '("11" "12" "1 1" "1 2" "1.1" "1.2")
+ (sort (list "11" "12" "1 1" "1 2" "1.1" "1.2")
(lambda (a b)
(let ((w32-collate-ignore-punctuation t))
(string-collate-lessp
@@ -190,7 +190,7 @@
;; Diacritics are different letters for POSIX, they sort lexicographical.
(should
(equal
- (sort '("Ævar" "Agustín" "Adrian" "Eli")
+ (sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b) (string-collate-lessp a b "POSIX")))
'("Adrian" "Agustín" "Eli" "Ævar")))
;; Diacritics are sorted between similar letters for other locales,
@@ -198,7 +198,7 @@
(when (eq system-type 'windows-nt)
(should
(equal
- (sort '("Ævar" "Agustín" "Adrian" "Eli")
+ (sort (list "Ævar" "Agustín" "Adrian" "Eli")
(lambda (a b)
(let ((w32-collate-ignore-punctuation t))
(string-collate-lessp
@@ -212,7 +212,7 @@
(should (not (string-version-lessp "foo20000.png" "foo12.png")))
(should (string-version-lessp "foo.png" "foo2.png"))
(should (not (string-version-lessp "foo2.png" "foo.png")))
- (should (equal (sort '("foo12.png" "foo2.png" "foo1.png")
+ (should (equal (sort (list "foo12.png" "foo2.png" "foo1.png")
'string-version-lessp)
'("foo1.png" "foo2.png" "foo12.png")))
(should (string-version-lessp "foo2" "foo1234"))
@@ -432,9 +432,9 @@
(should-error (mapcan))
(should-error (mapcan #'identity))
(should-error (mapcan #'identity (make-char-table 'foo)))
- (should (equal (mapcan #'list '(1 2 3)) '(1 2 3)))
+ (should (equal (mapcan #'list (list 1 2 3)) '(1 2 3)))
;; `mapcan' is destructive
- (let ((data '((foo) (bar))))
+ (let ((data (list (list 'foo) (list 'bar))))
(should (equal (mapcan #'identity data) '(foo bar)))
(should (equal data '((foo bar) (bar))))))
- branch feature/zach-soc-funcall-from-bytecode created (now e1aee0f), Rocky Bernstein, 2020/06/26
- feature/zach-soc-funcall-from-bytecode b417cf0 1/6: Merge branch 'master' into feature/soc-bytecode-in-traceback-specbinding,
Rocky Bernstein <=
- feature/zach-soc-funcall-from-bytecode f6ec28d 4/6: Store bytecode offset within exec_byte_code, Rocky Bernstein, 2020/06/26
- feature/zach-soc-funcall-from-bytecode 3d5ac37 5/6: Revert "Store bytecode offset within exec_byte_code", Rocky Bernstein, 2020/06/26
- feature/zach-soc-funcall-from-bytecode 629d179 3/6: Properly align offset in backtrace, Rocky Bernstein, 2020/06/26
- feature/zach-soc-funcall-from-bytecode e1aee0f 6/6: Don't call Ffuncall directly from exec_byte_code, Rocky Bernstein, 2020/06/26
- feature/zach-soc-funcall-from-bytecode 0c45e51 2/6: Merge branch 'master' into feature/soc-bytecode-in-traceback-specbinding, Rocky Bernstein, 2020/06/26