[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/tree-sitter aaeaa310f0 5/8: Merge remote-tracking branch 'savann
|
From: |
Yuan Fu |
|
Subject: |
feature/tree-sitter aaeaa310f0 5/8: Merge remote-tracking branch 'savannah/master' into feature/tree-sitter |
|
Date: |
Mon, 21 Nov 2022 16:38:43 -0500 (EST) |
branch: feature/tree-sitter
commit aaeaa310f0391f5a5193e1a3d6e026986c4f2c0c
Merge: b2ea38ab03 f176a36f46
Author: Yuan Fu <casouri@gmail.com>
Commit: Yuan Fu <casouri@gmail.com>
Merge remote-tracking branch 'savannah/master' into feature/tree-sitter
---
.clang-format | 14 +-
.dir-locals.el | 8 +-
.gitignore | 3 +-
CONTRIBUTE | 7 +-
ChangeLog.1 | 4 +-
ChangeLog.2 | 6 +-
ChangeLog.3 | 240 +-
INSTALL | 2 +-
Makefile.in | 23 +-
admin/authors.el | 2 +-
admin/automerge | 23 +-
admin/charsets/mapfiles/stdenc.txt | 2 +-
admin/charsets/mapfiles/symbol.txt | 2 +-
admin/cus-test.el | 2 +-
admin/diff-tar-files | 8 +-
admin/emacs-shell-lib | 87 +
admin/emake | 17 +
admin/git-bisect-start | 40 +
admin/grammars/srecode-template.wy | 2 +-
admin/last-chance.el | 2 +-
admin/make-manuals | 13 +-
admin/make-tarball.txt | 2 +-
admin/notes/bug-triage | 2 +-
admin/notes/repo | 22 +
admin/unidata/README | 14 +-
admin/unidata/blocks.awk | 2 +-
admin/unidata/copyright.html | 18 +-
admin/update_autogen | 20 +-
admin/upload-manuals | 10 +-
configure.ac | 8 +
doc/emacs/ChangeLog.1 | 4 +-
doc/emacs/building.texi | 11 +-
doc/emacs/custom.texi | 36 +-
doc/emacs/dired.texi | 2 +-
doc/emacs/display.texi | 2 +-
doc/emacs/emacs.texi | 2 +-
doc/emacs/haiku.texi | 2 +-
doc/emacs/killing.texi | 4 +-
doc/emacs/macos.texi | 6 +-
doc/emacs/maintaining.texi | 37 +-
doc/emacs/mark.texi | 17 +-
doc/emacs/misc.texi | 2 +-
doc/emacs/modes.texi | 2 +-
doc/emacs/package.texi | 71 +
doc/emacs/programs.texi | 213 +-
doc/emacs/rmail.texi | 8 +
doc/emacs/search.texi | 25 +-
doc/emacs/text.texi | 19 +-
doc/emacs/vc1-xtra.texi | 32 +
doc/lispref/backups.texi | 2 +-
doc/lispref/buffers.texi | 10 +-
doc/lispref/commands.texi | 2 +-
doc/lispref/compile.texi | 22 +-
doc/lispref/control.texi | 2 +-
doc/lispref/customize.texi | 24 +-
doc/lispref/display.texi | 10 +-
doc/lispref/edebug.texi | 29 +-
doc/lispref/errors.texi | 2 +-
doc/lispref/files.texi | 36 +-
doc/lispref/frames.texi | 111 +-
doc/lispref/functions.texi | 40 +-
doc/lispref/help.texi | 4 +-
doc/lispref/internals.texi | 20 +-
doc/lispref/intro.texi | 2 +
doc/lispref/lists.texi | 8 +-
doc/lispref/loading.texi | 2 +-
doc/lispref/minibuf.texi | 2 +-
doc/lispref/modes.texi | 17 +-
doc/lispref/numbers.texi | 48 +-
doc/lispref/processes.texi | 6 +-
doc/lispref/searching.texi | 57 +-
doc/lispref/strings.texi | 2 +-
doc/lispref/symbols.texi | 8 +-
doc/lispref/text.texi | 21 +-
doc/lispref/variables.texi | 110 +-
doc/lispref/windows.texi | 20 +-
doc/misc/ChangeLog.1 | 15 +-
doc/misc/Makefile.in | 14 +-
doc/misc/auth.texi | 18 +
doc/misc/cc-mode.texi | 10 +-
doc/misc/cl.texi | 6 +-
doc/misc/ede.texi | 168 +-
doc/misc/efaq-w32.texi | 8 +-
doc/misc/efaq.texi | 8 +-
doc/misc/eglot.texi | 1160 ++++
doc/misc/erc.texi | 31 +-
doc/misc/eshell.texi | 83 +-
doc/misc/eudc.texi | 143 +-
doc/misc/flymake.texi | 12 +-
doc/misc/gnus-faq.texi | 6 +-
doc/misc/gnus.texi | 75 +-
doc/misc/message.texi | 2 +-
doc/misc/mh-e.texi | 14 +-
doc/misc/modus-themes.org | 179 +-
doc/misc/newsticker.texi | 2 +-
doc/misc/octave-mode.texi | 7 +-
doc/misc/org.org | 30 +-
doc/misc/rcirc.texi | 4 +-
doc/misc/reftex.texi | 4 +-
doc/misc/remember.texi | 7 -
doc/misc/sem-user.texi | 2 +-
doc/misc/semantic.texi | 2 +-
doc/misc/ses.texi | 4 +-
doc/misc/sieve.texi | 2 +-
doc/misc/srecode.texi | 2 +-
doc/misc/tramp.texi | 14 +-
doc/misc/transient.texi | 4 +-
doc/misc/url.texi | 2 +-
doc/misc/vhdl-mode.texi | 2 +-
doc/misc/vip.texi | 4 +-
etc/DEBUG | 2 +-
etc/ERC-NEWS | 25 +-
etc/HELLO | 1 +
etc/NEWS | 333 +-
etc/NEWS.21 | 2 +-
etc/NEWS.22 | 2 +-
etc/NEWS.25 | 2 +-
etc/NEWS.26 | 2 +-
etc/NEWS.27 | 2 +-
etc/NEWS.28 | 4 +-
etc/NEXTSTEP | 2 +-
etc/ORG-NEWS | 8 +-
etc/PROBLEMS | 67 +-
etc/TODO | 12 +-
etc/images/gud/README | 4 +-
etc/publicsuffix.txt | 259 +-
etc/srecode/ede-autoconf.srt | 2 +-
etc/srecode/ede-make.srt | 4 +-
etc/themes/adwaita-theme.el | 5 +-
etc/themes/deeper-blue-theme.el | 5 +-
etc/themes/dichromacy-theme.el | 43 +-
etc/themes/leuven-dark-theme.el | 8 +-
etc/themes/leuven-theme.el | 8 +-
etc/themes/light-blue-theme.el | 5 +-
etc/themes/manoj-dark-theme.el | 5 +-
etc/themes/misterioso-theme.el | 5 +-
etc/themes/modus-operandi-theme.el | 5 +-
etc/themes/modus-themes.el | 198 +-
etc/themes/modus-vivendi-theme.el | 7 +-
etc/themes/tango-dark-theme.el | 7 +-
etc/themes/tango-theme.el | 6 +-
etc/themes/tsdh-dark-theme.el | 6 +-
etc/themes/tsdh-light-theme.el | 6 +-
etc/themes/wheatgrass-theme.el | 5 +-
etc/themes/whiteboard-theme.el | 5 +-
etc/themes/wombat-theme.el | 5 +-
lib-src/ebrowse.c | 63 +-
lib-src/emacsclient.c | 2 +-
lib-src/rcs2log | 2 +-
lib-src/seccomp-filter.c | 6 +
lisp/ChangeLog.10 | 6 +-
lisp/ChangeLog.12 | 8 +-
lisp/ChangeLog.13 | 6 +-
lisp/ChangeLog.14 | 6 +-
lisp/ChangeLog.15 | 8 +-
lisp/ChangeLog.16 | 27 +-
lisp/ChangeLog.17 | 4 +-
lisp/ChangeLog.3 | 3 +-
lisp/ChangeLog.4 | 2 +-
lisp/ChangeLog.6 | 2 +-
lisp/ChangeLog.7 | 10 +-
lisp/ChangeLog.8 | 4 +-
lisp/ChangeLog.9 | 2 +-
lisp/Makefile.in | 6 +
lisp/abbrev.el | 2 +-
lisp/allout-widgets.el | 2 +-
lisp/allout.el | 3 -
lisp/ansi-color.el | 2 +-
lisp/ansi-osc.el | 14 +-
lisp/apropos.el | 11 +-
lisp/auth-source-pass.el | 112 +-
lisp/autoinsert.el | 4 +-
lisp/autorevert.el | 5 +-
lisp/battery.el | 6 +-
lisp/bindings.el | 8 +
lisp/bookmark.el | 35 +-
lisp/bs.el | 50 +-
lisp/buff-menu.el | 54 +-
lisp/calc/calc-graph.el | 2 +-
lisp/calendar/diary-lib.el | 6 +-
lisp/cedet/ChangeLog.1 | 11 +-
lisp/cedet/ede.el | 2 +-
lisp/cedet/ede/locate.el | 4 +-
lisp/cedet/ede/makefile-edit.el | 2 +-
lisp/cedet/ede/proj.el | 6 +-
lisp/cedet/ede/project-am.el | 4 +-
lisp/cedet/pulse.el | 2 +-
lisp/cedet/semantic.el | 10 +-
lisp/cedet/semantic/analyze/fcn.el | 4 +-
lisp/cedet/semantic/bovine/c.el | 4 +-
lisp/cedet/semantic/complete.el | 2 +-
lisp/cedet/semantic/db-ebrowse.el | 2 +-
lisp/cedet/semantic/db-find.el | 2 +-
lisp/cedet/semantic/decorate/include.el | 2 +-
lisp/cedet/semantic/edit.el | 10 +-
lisp/cedet/semantic/grm-wy-boot.el | 4 +-
lisp/cedet/semantic/idle.el | 2 +-
lisp/cedet/semantic/scope.el | 4 +-
lisp/cedet/semantic/symref/grep.el | 11 +-
lisp/cedet/semantic/symref/list.el | 5 +-
lisp/cedet/semantic/tag.el | 2 +-
lisp/cedet/semantic/util-modes.el | 2 +-
lisp/cedet/semantic/wisent.el | 2 +-
lisp/cedet/srecode/document.el | 3 +-
lisp/cedet/srecode/extract.el | 2 +-
lisp/cedet/srecode/fields.el | 4 +-
lisp/cedet/srecode/insert.el | 4 +-
lisp/cedet/srecode/semantic.el | 4 +-
lisp/comint.el | 38 +-
lisp/cus-edit.el | 60 +-
lisp/cus-theme.el | 42 +-
lisp/custom.el | 73 +-
lisp/dabbrev.el | 3 -
lisp/dired-aux.el | 17 +-
lisp/dired.el | 18 +-
lisp/dnd.el | 4 +-
lisp/dom.el | 68 +-
lisp/dynamic-setting.el | 18 +-
lisp/ecomplete.el | 49 +-
lisp/elide-head.el | 4 +-
lisp/emacs-lisp/backtrace.el | 2 +-
lisp/emacs-lisp/benchmark.el | 1 +
lisp/emacs-lisp/bindat.el | 6 +-
lisp/emacs-lisp/byte-opt.el | 2 +-
lisp/emacs-lisp/byte-run.el | 5 +
lisp/emacs-lisp/bytecomp.el | 92 +-
lisp/emacs-lisp/cconv.el | 150 +-
lisp/emacs-lisp/checkdoc.el | 4 +-
lisp/emacs-lisp/cl-extra.el | 4 +-
lisp/emacs-lisp/cl-generic.el | 6 +-
lisp/emacs-lisp/cl-macs.el | 2 +
lisp/emacs-lisp/comp-cstr.el | 2 +-
lisp/emacs-lisp/comp.el | 215 +-
lisp/emacs-lisp/crm.el | 2 +-
lisp/emacs-lisp/eldoc.el | 127 +-
lisp/emacs-lisp/ert-x.el | 1 +
lisp/emacs-lisp/ert.el | 2 +-
lisp/emacs-lisp/gv.el | 7 +-
lisp/emacs-lisp/hierarchy.el | 87 +-
lisp/emacs-lisp/icons.el | 25 +-
lisp/emacs-lisp/loaddefs-gen.el | 15 +-
lisp/emacs-lisp/map.el | 164 +-
lisp/emacs-lisp/memory-report.el | 7 +-
lisp/emacs-lisp/multisession.el | 11 +
lisp/emacs-lisp/oclosure.el | 6 +-
lisp/emacs-lisp/package-vc.el | 791 +++
lisp/emacs-lisp/package.el | 339 +-
lisp/emacs-lisp/re-builder.el | 31 +-
lisp/emacs-lisp/rmc.el | 2 +-
lisp/emacs-lisp/seq.el | 126 +-
lisp/emacs-lisp/shortdoc.el | 26 +-
lisp/emacs-lisp/smie.el | 2 +-
lisp/emacs-lisp/subr-x.el | 4 +
lisp/emacs-lisp/tabulated-list.el | 2 +-
lisp/emacs-lisp/tcover-ses.el | 2 +-
lisp/emacs-lisp/text-property-search.el | 10 +-
lisp/emacs-lisp/vtable.el | 14 +-
lisp/erc/ChangeLog.1 | 13 +-
lisp/erc/erc-backend.el | 269 +-
lisp/erc/erc-button.el | 1 -
lisp/erc/erc-capab.el | 2 +-
lisp/erc/erc-common.el | 274 +
lisp/erc/erc-compat.el | 157 +
lisp/erc/erc-dcc.el | 7 +-
lisp/erc/erc-goodies.el | 17 +-
lisp/erc/erc-networks.el | 39 +-
lisp/erc/erc-pcomplete.el | 4 +
lisp/erc/erc.el | 613 +-
lisp/eshell/em-prompt.el | 8 +
lisp/eshell/em-script.el | 3 +-
lisp/eshell/em-smart.el | 3 +-
lisp/eshell/em-tramp.el | 94 +-
lisp/eshell/em-unix.el | 6 +-
lisp/eshell/esh-arg.el | 3 +-
lisp/eshell/esh-cmd.el | 12 +-
lisp/eshell/esh-ext.el | 23 +-
lisp/eshell/esh-mode.el | 10 +-
lisp/eshell/esh-proc.el | 20 +-
lisp/eshell/esh-util.el | 68 +-
lisp/eshell/esh-var.el | 156 +-
lisp/face-remap.el | 57 +-
lisp/faces.el | 23 +-
lisp/files-x.el | 118 +-
lisp/files.el | 40 +-
lisp/filesets.el | 4 +-
lisp/follow.el | 2 +-
lisp/font-lock.el | 20 +-
lisp/format.el | 7 +-
lisp/forms.el | 34 +-
lisp/gnus/ChangeLog.1 | 2 +-
lisp/gnus/ChangeLog.3 | 8 +-
lisp/gnus/gnus-art.el | 207 +-
lisp/gnus/gnus-bookmark.el | 2 +-
lisp/gnus/gnus-cite.el | 22 +-
lisp/gnus/gnus-cus.el | 5 +-
lisp/gnus/gnus-gravatar.el | 1 -
lisp/gnus/gnus-group.el | 9 +-
lisp/gnus/gnus-rfc1843.el | 3 +-
lisp/gnus/gnus-search.el | 2 +-
lisp/gnus/gnus-start.el | 4 +-
lisp/gnus/gnus-sum.el | 1 -
lisp/gnus/gnus-util.el | 5 +-
lisp/gnus/message.el | 22 +-
lisp/gnus/mm-bodies.el | 20 +-
lisp/gnus/mm-uu.el | 2 +-
lisp/gnus/mml.el | 2 +-
lisp/gnus/nndoc.el | 2 +-
lisp/gnus/nnimap.el | 2 +-
lisp/gnus/nnrss.el | 6 +-
lisp/gnus/nnvirtual.el | 2 +-
lisp/gnus/smime.el | 2 +-
lisp/help-fns.el | 2 +-
lisp/help-macro.el | 12 +-
lisp/help.el | 266 +-
lisp/hl-line.el | 3 +-
lisp/htmlfontify.el | 26 +-
lisp/icomplete.el | 4 +-
lisp/ido.el | 2 +-
lisp/image/image-dired-external.el | 2 +-
lisp/image/wallpaper.el | 136 +-
lisp/info-look.el | 1 +
lisp/info.el | 12 +-
lisp/international/emoji.el | 3 +-
lisp/international/fontset.el | 3 +-
lisp/international/mule-cmds.el | 93 +-
lisp/international/mule-diag.el | 2 +-
lisp/international/textsec.el | 2 +-
lisp/international/titdic-cnv.el | 7 +
lisp/isearch.el | 3 +-
lisp/jit-lock.el | 26 +-
lisp/jka-compr.el | 2 +-
lisp/keymap.el | 60 +-
lisp/language/ethio-util.el | 92 +-
lisp/language/ethiopic.el | 7 +
lisp/language/ind-util.el | 11 +-
lisp/language/indonesian.el | 21 +-
lisp/language/misc-lang.el | 30 +-
lisp/language/philippine.el | 12 +-
lisp/language/tibet-util.el | 7 +
lisp/language/tibetan.el | 7 +
lisp/ldefs-boot.el | 335 +-
lisp/leim/quail/ethiopic.el | 7 +
lisp/leim/quail/indian.el | 165 +-
lisp/leim/quail/japanese.el | 2 +-
lisp/leim/quail/misc-lang.el | 119 +-
lisp/leim/quail/slovak.el | 125 +-
lisp/leim/quail/tibetan.el | 7 +
lisp/loadup.el | 10 +-
lisp/mail/feedmail.el | 17 +-
lisp/mail/ietf-drums-date.el | 4 +-
lisp/mail/mail-hist.el | 23 +-
lisp/mail/reporter.el | 2 +-
lisp/mail/rfc6068.el | 4 +-
lisp/mail/rmail.el | 24 +-
lisp/mail/rmailsum.el | 227 +-
lisp/mail/sendmail.el | 8 +-
lisp/mail/supercite.el | 2 +-
lisp/man.el | 99 +-
lisp/menu-bar.el | 10 +-
lisp/mh-e/ChangeLog.1 | 4 +-
lisp/mh-e/ChangeLog.2 | 4 +-
lisp/mh-e/mh-junk.el | 4 +-
lisp/mh-e/mh-mime.el | 5 +-
lisp/mh-e/mh-scan.el | 6 +-
lisp/minibuf-eldef.el | 3 +-
lisp/minibuffer.el | 99 +-
lisp/mpc.el | 2 +-
lisp/net/ange-ftp.el | 4 +-
lisp/net/browse-url.el | 29 +
lisp/net/dbus.el | 1 +
lisp/net/dictionary.el | 12 +-
lisp/net/eudc-capf.el | 11 +-
lisp/net/eudc-vars.el | 13 +-
lisp/net/eudc.el | 85 +-
lisp/net/eudcb-ecomplete.el | 108 +
lisp/net/eudcb-mailabbrev.el | 130 +
lisp/net/eww.el | 6 +-
lisp/net/goto-addr.el | 89 +-
lisp/net/ldap.el | 13 +-
lisp/net/network-stream.el | 4 +
lisp/net/newst-backend.el | 1 -
lisp/net/rcirc.el | 39 +-
lisp/net/sieve-manage.el | 2 +-
lisp/net/tramp-archive.el | 24 +-
lisp/net/tramp-cache.el | 27 +-
lisp/net/tramp-compat.el | 2 +-
lisp/net/tramp-container.el | 28 +-
lisp/net/tramp-crypt.el | 2 +-
lisp/net/tramp-integration.el | 23 +-
lisp/net/tramp-sh.el | 48 +-
lisp/net/tramp-sudoedit.el | 57 +-
lisp/net/tramp.el | 92 +-
lisp/net/trampver.el | 2 +-
lisp/nxml/nxml-mode.el | 8 +-
lisp/nxml/nxml-util.el | 6 -
lisp/nxml/rng-cmpct.el | 22 +-
lisp/nxml/rng-nxml.el | 77 +-
lisp/nxml/rng-uri.el | 8 +-
lisp/nxml/rng-valid.el | 37 +-
lisp/obsolete/linum.el | 5 +-
lisp/obsolete/vi.el | 4 +-
lisp/org/ChangeLog.1 | 30 +-
lisp/org/ob-R.el | 2 +-
lisp/org/ob-matlab.el | 2 +-
lisp/org/ob-plantuml.el | 2 +-
lisp/org/ob-tangle.el | 4 +-
lisp/org/ol.el | 2 +-
lisp/org/org-agenda.el | 2 +-
lisp/org/org-clock.el | 3 +-
lisp/org/org-ctags.el | 4 +-
lisp/org/org-element.el | 2 +-
lisp/org/org-faces.el | 2 +-
lisp/org/org-id.el | 2 +-
lisp/org/org-protocol.el | 5 +-
lisp/org/org.el | 12 +-
lisp/org/ox-ascii.el | 2 +-
lisp/org/ox-koma-letter.el | 4 +-
lisp/org/ox-odt.el | 6 +-
lisp/org/ox.el | 2 +-
lisp/outline.el | 484 +-
lisp/pcomplete.el | 19 +-
lisp/play/zone.el | 50 +-
lisp/printing.el | 6 +-
lisp/proced.el | 26 +-
lisp/profiler.el | 131 +-
lisp/progmodes/antlr-mode.el | 18 +-
lisp/progmodes/cc-bytecomp.el | 2 +-
lisp/progmodes/cc-cmds.el | 2 +-
lisp/progmodes/cc-defs.el | 3 +-
lisp/progmodes/cc-engine.el | 230 +-
lisp/progmodes/cc-fonts.el | 319 +-
lisp/progmodes/cc-langs.el | 246 +-
lisp/progmodes/cc-mode.el | 21 +-
lisp/progmodes/compile.el | 11 +-
lisp/progmodes/cperl-mode.el | 68 +-
lisp/progmodes/cpp.el | 101 +-
lisp/progmodes/dcl-mode.el | 60 +-
lisp/progmodes/ebnf2ps.el | 8 +-
lisp/progmodes/eglot.el | 3469 ++++++++++
lisp/progmodes/elisp-mode.el | 71 +-
lisp/progmodes/etags.el | 22 +-
lisp/progmodes/flymake-cc.el | 2 +-
lisp/progmodes/flymake.el | 7 +-
lisp/progmodes/fortran.el | 59 +-
lisp/progmodes/gdb-mi.el | 4 +-
lisp/progmodes/gud.el | 7 +-
lisp/progmodes/hideshow.el | 120 +-
lisp/progmodes/idlw-shell.el | 2 +-
lisp/progmodes/make-mode.el | 319 +-
lisp/progmodes/mixal-mode.el | 3 -
lisp/progmodes/modula2.el | 63 +-
lisp/progmodes/octave.el | 72 +-
lisp/progmodes/opascal.el | 3 +-
lisp/progmodes/perl-mode.el | 13 +-
lisp/progmodes/prog-mode.el | 2 +-
lisp/progmodes/project.el | 66 +-
lisp/progmodes/prolog.el | 2 +-
lisp/progmodes/ps-mode.el | 50 +-
lisp/progmodes/python.el | 74 +-
lisp/progmodes/ruby-mode.el | 4 +-
lisp/progmodes/sh-script.el | 2 +-
lisp/progmodes/simula.el | 42 +-
lisp/progmodes/sql.el | 64 +-
lisp/progmodes/verilog-mode.el | 19 +-
lisp/progmodes/vhdl-mode.el | 7 +-
lisp/progmodes/xref.el | 26 +-
lisp/repeat.el | 65 +-
lisp/replace.el | 2 +-
lisp/rot13.el | 11 +-
lisp/savehist.el | 6 +-
lisp/scroll-bar.el | 2 +-
lisp/server.el | 36 +-
lisp/shell.el | 8 +
lisp/simple.el | 122 +-
lisp/so-long.el | 4 +-
lisp/startup.el | 45 +-
lisp/subr.el | 60 +-
lisp/tab-bar.el | 292 +-
lisp/tab-line.el | 37 +-
lisp/term/pgtk-win.el | 2 +-
lisp/textmodes/bibtex.el | 132 +-
lisp/textmodes/css-mode.el | 38 +-
lisp/textmodes/emacs-news-mode.el | 9 +-
lisp/textmodes/enriched.el | 3 +-
lisp/textmodes/flyspell.el | 6 +-
lisp/textmodes/less-css-mode.el | 2 +-
lisp/textmodes/page-ext.el | 38 +-
lisp/textmodes/reftex-cite.el | 2 +-
lisp/textmodes/reftex-index.el | 2 +-
lisp/textmodes/sgml-mode.el | 4 +-
lisp/textmodes/string-edit.el | 12 +-
lisp/textmodes/table.el | 28 +-
lisp/textmodes/tex-mode.el | 6 +-
lisp/thingatpt.el | 2 +-
lisp/thread.el | 26 +-
lisp/transient.el | 209 +-
lisp/url/ChangeLog.1 | 2 +-
lisp/url/url-file.el | 1 -
lisp/url/url-irc.el | 32 +-
lisp/url/url-util.el | 37 +-
lisp/url/url.el | 2 +-
lisp/vc/add-log.el | 2 +-
lisp/vc/diff-mode.el | 2 +-
lisp/vc/ediff-diff.el | 35 +-
lisp/vc/ediff-util.el | 2 +-
lisp/vc/log-view.el | 1 +
lisp/vc/smerge-mode.el | 5 +-
lisp/vc/vc-bzr.el | 20 +
lisp/vc/vc-dav.el | 2 +-
lisp/vc/vc-git.el | 76 +-
lisp/vc/vc-hg.el | 54 +-
lisp/vc/vc-rcs.el | 2 +-
lisp/vc/vc-svn.el | 9 +-
lisp/vc/vc.el | 252 +-
lisp/vcursor.el | 82 +-
lisp/view.el | 7 -
lisp/whitespace.el | 287 +-
lisp/window.el | 41 +-
lisp/winner.el | 8 +
lisp/woman.el | 26 +-
lisp/x-dnd.el | 19 +-
lisp/xwidget.el | 12 +-
msdos/autogen/config.in | 2 +-
nt/INSTALL | 24 +-
nt/INSTALL.W64 | 2 +-
nt/inc/ms-w32.h | 2 +-
oldXMenu/Activate.c | 10 -
oldXMenu/XMenu.h | 2 -
src/ChangeLog.10 | 2 +-
src/ChangeLog.11 | 6 +-
src/ChangeLog.12 | 8 +-
src/ChangeLog.13 | 18 +-
src/ChangeLog.5 | 2 +-
src/ChangeLog.6 | 2 +-
src/ChangeLog.7 | 8 +-
src/ChangeLog.8 | 6 +-
src/Makefile.in | 39 +-
src/alloc.c | 67 +-
src/buffer.c | 1528 ++---
src/buffer.h | 111 +-
src/callproc.c | 32 +-
src/comp.c | 21 +-
src/dbusbind.c | 4 +-
src/dired.c | 5 +-
src/dispextern.h | 3 +-
src/dispnew.c | 9 +
src/editfns.c | 80 +-
src/emacs-module.c | 2 +-
src/emacs.c | 8 +-
src/eval.c | 43 +-
src/fileio.c | 8 +-
src/fns.c | 224 +-
src/font.h | 6 +-
src/fontset.c | 12 +-
src/frame.c | 143 +-
src/frame.h | 1 +
src/ftcrfont.c | 38 +-
src/ftfont.h | 7 +
src/gnutls.c | 12 +-
src/haiku_support.cc | 18 +
src/haiku_support.h | 2 +-
src/haikufns.c | 17 +-
src/haikuselect.c | 2 +-
src/haikuterm.c | 47 +-
src/haikuterm.h | 5 +
src/image.c | 30 +-
src/indent.c | 13 +-
src/insdel.c | 69 +-
src/intervals.c | 4 +-
src/itree.c | 1428 ++++
src/itree.h | 181 +
src/keyboard.c | 69 +-
src/lisp.h | 38 +-
src/lread.c | 21 +-
src/menu.c | 12 +
src/minibuf.c | 12 +-
src/msdos.h | 1 -
src/nsfns.m | 17 +-
src/nsimage.m | 2 +
src/nsterm.m | 64 +-
src/pdumper.c | 70 +-
src/pgtkfns.c | 24 +-
src/pgtkterm.c | 257 +-
src/pgtkterm.h | 11 +-
src/print.c | 18 +-
src/process.c | 3 +-
src/regex-emacs.c | 14 +-
src/search.c | 37 +-
src/sqlite.c | 241 +-
src/sysdep.c | 2 +-
src/textprop.c | 67 +-
src/w32fns.c | 30 +-
src/w32inevt.c | 2 +-
src/widget.c | 42 +-
src/widget.h | 2 +-
src/widgetprv.h | 3 -
src/window.c | 114 +-
src/window.h | 10 +
src/xdisp.c | 317 +-
src/xfaces.c | 37 +-
src/xfns.c | 195 +-
src/xmenu.c | 67 +-
src/xselect.c | 41 +-
src/xsettings.c | 41 +-
src/xterm.c | 1957 ++++--
src/xterm.h | 108 +-
test/lisp/apropos-tests.el | 17 +-
test/lisp/auth-source-pass-tests.el | 275 +-
test/lisp/autorevert-tests.el | 2 +-
test/lisp/calendar/icalendar-tests.el | 2 +-
test/lisp/cedet/semantic-utest.el | 1 -
test/lisp/cedet/srecode/fields-tests.el | 2 +-
test/lisp/dired-tests.el | 11 +
test/lisp/dnd-tests.el | 2 +-
test/lisp/elide-head-tests.el | 21 +-
test/lisp/emacs-lisp/bindat-tests.el | 19 +-
test/lisp/emacs-lisp/cconv-tests.el | 17 +-
test/lisp/emacs-lisp/cl-extra-tests.el | 24 +-
test/lisp/emacs-lisp/cl-generic-tests.el | 22 +
test/lisp/emacs-lisp/cl-macs-tests.el | 6 +
test/lisp/emacs-lisp/comp-tests.el | 77 +
test/lisp/emacs-lisp/gv-tests.el | 75 +-
test/lisp/emacs-lisp/hierarchy-tests.el | 143 +
test/lisp/emacs-lisp/map-tests.el | 204 +-
.../emacs-lisp/package-resources/elpa-packages.eld | 3 +
.../newer-versions/elpa-packages.eld | 3 +
.../package-resources/signed/elpa-packages.eld | 3 +
.../package-resources/signed/elpa-packages.eld.sig | Bin 0 -> 119 bytes
.../package-resources/signed/update-signatures.sh | 1 +
.../package-resources/ustar-withsub-0.1.tar | Bin 0 -> 10240 bytes
.../package-resources/v7-withsub-0.1.tar | Bin 0 -> 10240 bytes
.../with-nil-entry/elpa-packages.eld | 3 +
test/lisp/emacs-lisp/package-tests.el | 24 +-
test/lisp/emacs-lisp/syntax-tests.el | 2 +-
test/lisp/erc/erc-dcc-tests.el | 120 +-
test/lisp/erc/erc-networks-tests.el | 19 +-
test/lisp/erc/erc-scenarios-base-reconnect.el | 46 +
test/lisp/erc/erc-scenarios-misc.el | 28 +
test/lisp/erc/erc-services-tests.el | 27 +-
test/lisp/erc/erc-tests.el | 247 +-
test/lisp/erc/resources/erc-d/erc-d-tests.el | 1 +
test/lisp/erc/resources/erc-scenarios-common.el | 3 +-
test/lisp/erc/resources/join/legacy/foonet.eld | 2 +-
test/lisp/eshell/em-tramp-tests.el | 75 +
test/lisp/eshell/esh-ext-tests.el | 76 +
test/lisp/eshell/esh-util-tests.el | 57 +
test/lisp/eshell/esh-var-tests.el | 222 +-
test/lisp/eshell/eshell-tests-helpers.el | 45 +-
test/lisp/files-x-tests.el | 152 +-
test/lisp/image/wallpaper-tests.el | 98 +
test/lisp/international/textsec-tests.el | 2 +-
test/lisp/net/browse-url-tests.el | 9 +
test/lisp/net/dbus-tests.el | 6 +-
test/lisp/net/eudc-resources/bbdb | 3 +
test/lisp/net/eudc-resources/dc=gnu,dc=org.ldif | 15 +
.../dc=gnu,dc=org/cn=emacs-ert-test-1.ldif | 17 +
.../dc=gnu,dc=org/cn=emacs-ert-test-2.ldif | 17 +
test/lisp/net/eudc-resources/ecompleterc | 7 +
test/lisp/net/eudc-resources/mailrc | 3 +
test/lisp/net/eudc-resources/slapd.conf | 7 +
test/lisp/net/eudc-tests.el | 311 +
test/lisp/net/mailcap-tests.el | 2 +-
test/lisp/net/puny-resources/IdnaTestV2.txt | 4 +-
test/lisp/net/tramp-tests.el | 18 +-
.../progmodes/cperl-mode-resources/here-docs.pl | 66 +
test/lisp/progmodes/python-tests.el | 250 +
test/lisp/progmodes/ruby-mode-resources/ruby.rb | 4 +-
test/lisp/server-tests.el | 41 +
test/lisp/simple-tests.el | 24 +
test/lisp/subr-tests.el | 7 +-
test/lisp/thingatpt-tests.el | 3 +
test/lisp/time-stamp-tests.el | 8 +-
test/lisp/vc/vc-tests.el | 2 +-
test/manual/image-circular-tests.el | 41 +-
test/manual/noverlay/.gitignore | 1 +
test/manual/noverlay/Makefile.in | 47 +
test/manual/noverlay/check-sanitize.sh | 33 +
test/manual/noverlay/emacs-compat.h | 76 +
test/manual/noverlay/itree-tests.c | 1289 ++++
test/manual/noverlay/many-errors.py | 2480 +++++++
test/manual/noverlay/overlay-perf.el | 764 +++
test/src/buffer-tests.el | 7193 +++++++++++++++++++-
test/src/comp-resources/comp-test-funcs.el | 8 +-
test/src/comp-tests.el | 6 +-
test/src/emacs-module-tests.el | 2 +-
test/src/eval-tests.el | 2 +-
test/src/fns-tests.el | 92 +-
test/src/font-tests.el | 2 +-
test/src/lcms-tests.el | 2 +-
test/src/regex-emacs-tests.el | 5 +
test/src/sqlite-tests.el | 13 +
test/src/thread-tests.el | 2 +-
692 files changed, 36801 insertions(+), 8978 deletions(-)
diff --git a/.clang-format b/.clang-format
index 44200a3995..2208240a66 100644
--- a/.clang-format
+++ b/.clang-format
@@ -1,12 +1,18 @@
Language: Cpp
BasedOnStyle: GNU
AlignEscapedNewlinesLeft: true
+AlignOperands: Align
AlwaysBreakAfterReturnType: TopLevelDefinitions
BreakBeforeBinaryOperators: All
BreakBeforeBraces: GNU
ColumnLimit: 70
ContinuationIndentWidth: 2
-ForEachMacros: [FOR_EACH_TAIL, FOR_EACH_TAIL_SAFE]
+ForEachMacros:
+ - FOR_EACH_TAIL
+ - FOR_EACH_TAIL_SAFE
+ - FOR_EACH_LIVE_BUFFER
+ - ITREE_FOREACH
+ - FOR_EACH_ALIST_VALUE
IncludeCategories:
- Regex: '^<config\.h>$'
Priority: -1
@@ -16,11 +22,17 @@ IncludeCategories:
Priority: 2
- Regex: '.*'
Priority: 3
+WhitespaceSensitiveMacros:
+ - STR
+ - CALL1I
+ - CALL2I
+ - STR_VALUE
KeepEmptyLinesAtTheStartOfBlocks: false
MaxEmptyLinesToKeep: 1
PenaltyBreakBeforeFirstCallParameter: 2000
SpaceAfterCStyleCast: true
SpaceBeforeParens: Always
+UseTab: Always
# Local Variables:
# mode: yaml
diff --git a/.dir-locals.el b/.dir-locals.el
index 84617a7980..f0ab46236f 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,4 +1,4 @@
-;;; Directory Local Variables
+;;; Directory Local Variables -*- no-byte-compile: t; -*-
;;; For more information see (info "(emacs) Directory Variables")
((nil . ((tab-width . 8)
@@ -7,9 +7,11 @@
(emacs-lisp-docstring-fill-column . 65)
(vc-git-annotate-switches . "-w")
(bug-reference-url-format . "https://debbugs.gnu.org/%s";)
- (diff-add-log-use-relative-names . t)))
+ (diff-add-log-use-relative-names . t)
+ (vc-prepare-patches-separately . nil)))
(c-mode . ((c-file-style . "GNU")
- (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED"
"UNINIT" "CALLBACK" "ALIGN_STACK"))
+ (c-noise-macro-names . ("INLINE" "NO_INLINE"
"ATTRIBUTE_NO_SANITIZE_UNDEFINED"
+ "UNINIT" "CALLBACK" "ALIGN_STACK"))
(electric-quote-comment . nil)
(electric-quote-string . nil)
(indent-tabs-mode . t)
diff --git a/.gitignore b/.gitignore
index c10b3b33d3..e6310b644a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -25,6 +25,7 @@
# Personal customization.
.dir-locals-2.el
+.no-advice-on-failure
# Built by 'autogen.sh'.
/aclocal.m4
@@ -324,7 +325,7 @@ lib-src/seccomp-filter-exec.pfc
/etc/*.gschema.valid
# Ignore directory made by admin/make-manuals.
-manual/
+/manual/
# Ignore Finder files on MacOS.
.DS_Store
diff --git a/CONTRIBUTE b/CONTRIBUTE
index 94d757daaf..c226645bd7 100644
--- a/CONTRIBUTE
+++ b/CONTRIBUTE
@@ -202,9 +202,10 @@ them right the first time, so here are guidelines for
formatting them:
you can put a paragraph (after the empty line and before the
individual ChangeLog entries) that further describes the commit.
-- Limit lines in commit messages to 78 characters, unless they consist
- of a single word of at most 140 characters; this is enforced by a
- commit hook.
+- Lines in ChangeLog entries should preferably be not longer than 63
+ characters, and must not exceed 78 characters, unless they consist
+ of a single word of at most 140 characters; this 78/140 limit is
+ enforced by a commit hook.
- If only a single file is changed, the summary line can be the normal
file first line (starting with the asterisk). Then there is no
diff --git a/ChangeLog.1 b/ChangeLog.1
index cd31aacafb..a8df1c0420 100644
--- a/ChangeLog.1
+++ b/ChangeLog.1
@@ -930,7 +930,7 @@
(mostlyclean_dirs, clean_dirs, distclean_dirs, maintainer_clean_dirs):
New variables.
(mostlyclean, clean, distclean, bootstrap-clean, maintainer-clean)
- (extraclean): Define using each subdirectory as a prequisite.
+ (extraclean): Define using each subdirectory as a prerequisite.
* lib/Makefile.am (bootstrap-clean): New.
2014-06-15 Paul Eggert <eggert@cs.ucla.edu>
@@ -5685,7 +5685,7 @@
(__mktime_internal): Use it systematically for all isdst comparisons.
This completes the fix for libc BZ #6723, and removes the need for
normalizing tm_isdst.
- See <http://sourceware.org/bugzilla/show_bug.cgi?id=6723>
+ See <https://sourceware.org/bugzilla/show_bug.cgi?id=6723>
(not_equal_tm) [DEBUG]: Use isdst_differ here, too.
mktime: fix some integer overflow issues and sidestep the rest
diff --git a/ChangeLog.2 b/ChangeLog.2
index 5a73d53b8b..483dec2542 100644
--- a/ChangeLog.2
+++ b/ChangeLog.2
@@ -9317,7 +9317,7 @@
optional.
* src/buffer.c (Fbarf_if_buffer_read_only): Rename argument POS
- to POSITION to keep consisteny with doc-string.
+ to POSITION to keep consistent with doc-string.
2016-02-01 Paul Eggert <eggert@cs.ucla.edu>
@@ -26343,7 +26343,7 @@
(verilog-type-font-keywords): Cycle delay operators like ##1 and
##[0:$] are now highlighted in their entirety similarly to the #
delay-control operator. Likewise, the followed-by operators #-#
- and #=# are no longer partially highlighed.
+ and #=# are no longer partially highlighted.
(verilog-backward-syntactic-ws-quick)
(verilog-skip-backward-comments): Minor performance improvements
to buffer traversal functions for reduced latency.
@@ -34464,7 +34464,7 @@
* lisp/emacs-lisp/package.el: Make archive and status pseudo-keywords
(package--has-keyword-p): Understand "arc:xxxx" and "status:xxxx"
- as special keywords which match agains package archive and status
+ as special keywords which match against package archive and status
respectively.
* etc/NEWS: Document it.
diff --git a/ChangeLog.3 b/ChangeLog.3
index a09dc29cbe..d27a14d427 100644
--- a/ChangeLog.3
+++ b/ChangeLog.3
@@ -4043,7 +4043,7 @@
* doc/emacs/maintaining.texi (Basic VC Editing): Mention Dired buffer.
- * doc/emacs/text.texi (Outline Mode): Replace S-TAB with with S-<TAB>.
+ * doc/emacs/text.texi (Outline Mode): Replace S-TAB with S-<TAB>.
* etc/NEWS: Add some missing +++/--- and move some related items closer.
@@ -5557,7 +5557,7 @@
Fix ert errors when there's a test that binds `debug-on-error'
* lisp/emacs-lisp/ert.el (ert--run-test-internal): Don't infloop
- on errors when signalling errors (bug#51131).
+ on errors when signaling errors (bug#51131).
2021-10-10 Paul Eggert <eggert@cs.ucla.edu>
@@ -5731,7 +5731,7 @@
2021-10-09 Dmitry Gutov <dgutov@yandex.ru>
- Slight simplificaiton
+ Slight simplification
* lisp/progmodes/xref.el (xref--insert-xrefs):
Compute log only once. Use 'dolist'.
@@ -12670,7 +12670,7 @@
2021-09-03 Lars Ingebrigtsen <larsi@gnus.org>
- Fix `describe-function' for autoloaded adviced functions
+ Fix `describe-function' for autoloaded advised functions
* lisp/emacs-lisp/nadvice.el (advice--make-single-doc): Factor
out.
@@ -20026,7 +20026,7 @@
Add query command removed in 4ff1f66b12
- * lisp/net/rcirc.el (query): Readd accidentally removed command
+ * lisp/net/rcirc.el (query): Re-add accidentally removed command.
2021-07-06 Philip Kaludercic <philipk@posteo.net>
@@ -21063,7 +21063,7 @@
Fix prompting for large files when loading literally
* lisp/files.el (find-file-noselect): Don't include "literally" in
- the "large file" prompt if we're gonna load literally anyway
+ the "large file" prompt if we're going to load literally anyway
(bug#49144).
2021-06-21 Lars Ingebrigtsen <larsi@gnus.org>
@@ -21772,7 +21772,7 @@
EIEIO: Promote the CLOS behavior over the EIEIO-specific behavior
- Change docs to advertize `slot-value` rather than `oref`.
+ Change docs to advertise `slot-value` rather than `oref`.
Change the implementation of `:initform` to better match the CLOS
semantics,
while preserving the EIEIO semantics, but warn when encountering cases
where the two diverge.
@@ -21790,8 +21790,8 @@
* lisp/emacs-lisp/eieio.el (defclass): Warn about inapplicable
`:initarg` and about uses of init forms that are ambiguous.
- (oref): Don't advertize the deprecated use of initargs as slot names.
- (oref-default): Don't advertize the deprecated case where it returns the
+ (oref): Don't advertise the deprecated use of initargs as slot names.
+ (oref-default): Don't advertise the deprecated case where it returns the
initform's value.
(initialize-instance): Use `macroexp-const-p`.
* lisp/emacs-lisp/eieio-core.el (eieio--unbound): Rename from
@@ -27204,7 +27204,7 @@
2021-04-25 Andrea Corallo <akrl@sdf.org>
- Merge branch 'feature/native-comp' into into trunk
+ Merge branch 'feature/native-comp' into trunk
2021-04-25 Lars Ingebrigtsen <larsi@gnus.org>
@@ -34265,7 +34265,7 @@
Use `length=' and family where possible in native comp code
* lisp/emacs-lisp/comp-cstr.el (comp-intersect-typesets)
- (comp-cstr-imm): Use Use `length=' and family where possible.
+ (comp-cstr-imm): Use `length=' and family where possible.
* lisp/emacs-lisp/comp.el (comp-add-cond-cstrs-target-block)
(comp-compute-dominator-frontiers)
(batch-byte-native-compile-for-bootstrap): Likewise.
@@ -35728,7 +35728,7 @@
(comp-arithm-cmp-fun-p, comp-negate-arithm-cmp-fun)
(comp-reverse-arithm-fun): Rename and add '=' '!='.
(comp-emit-assume, comp-add-cond-cstrs, comp-fwprop-insn): Update
- for new function nameing and to handle '='.
+ for new function naming and to handle '='.
* lisp/emacs-lisp/comp-cstr.el (comp-cstr-=): New function.
* test/src/comp-tests.el (comp-tests-type-spec-tests): Add a bunch
of '=' specific tests.
@@ -36674,7 +36674,7 @@
2021-02-24 Andrea Corallo <akrl@sdf.org>
- Fix async compilation and paramenter naming
+ Fix async compilation and parameter naming
* lisp/emacs-lisp/comp.el (native--compile-async)
(native-compile-async): Fix broken parameter renaming.
@@ -39854,7 +39854,7 @@
* lisp/net/mairix.el: Use lexical-binding.
Remove redundant `:group` args.
- (mairix-widget-create-query): Remove unnused var `allwidgets`.
+ (mairix-widget-create-query): Remove unused var `allwidgets`.
2021-02-09 Juri Linkov <juri@linkov.net>
@@ -40177,7 +40177,7 @@
* lisp/simple.el (recenter-current-error): New command.
* lisp/progmodes/grep.el (grep-mode-map):
- Delete bidings for n and p.
+ Delete bindings for n and p.
* lisp/progmodes/compile.el (compilation-minor-mode-map):
Move here the n and p bindings.
@@ -41213,7 +41213,7 @@
2021-02-02 Lars Ingebrigtsen <larsi@gnus.org>
- Fix up invalid_syntax error signalling
+ Fix up invalid_syntax error signaling
* src/lread.c (invalid_syntax_lisp): Instead of putting the
line/column in a string, signal an error containing the numbers as
@@ -41694,7 +41694,7 @@
in a global minor mode. This commit fixes bug #45792.
* lisp/international/quail.el (quail-show-guidance): Test the major
mode is
- not minibuffer-inactive-mode before proceding with the function.
+ not minibuffer-inactive-mode before proceeding with the function.
2021-01-31 Lars Ingebrigtsen <larsi@gnus.org>
@@ -43613,7 +43613,7 @@
RFC2047-encode invalid Subject/From headers (bug#45925). This
will make them be displayed more consistently in the Summary
buffer (but still "wrong" sometimes, since there's not that much
- we can guess at at this stage, charset wise).
+ we can guess at this stage, charset wise).
(nnml-parse-head): Use it.
2021-01-22 Michael Albinus <michael.albinus@gmx.de>
@@ -48572,7 +48572,7 @@
c-laomib-loop. Insert code which calls c-laomib-loop minimally, with
the help
of the new cache.
- * lisp/progmodes/cc-mode.el (c-basic-common-init): Initialize the new
cach
+ * lisp/progmodes/cc-mode.el (c-basic-common-init): Initialize the new
cache
(at mode start).
(c-before-change): Invalidate the new cache.
(c-fl-decl-start): Add an extra check (> (point) bod-lim) to prevent
looping.
@@ -49106,7 +49106,7 @@
(comp-split-pos-neg): Minor.
(comp-normalize-typeset): Logic update.
(comp-union-typesets): Minor.
- (comp-intersect-two-typesets): New functio.
+ (comp-intersect-two-typesets): New function.
(comp-intersect-typesets): Logic update.
(comp-range-union, comp-range-intersection): Minor.
(comp-cstr-union-homogeneous, comp-cstr-union-1-no-mem)
@@ -50078,7 +50078,7 @@
Optimize c-parse-state for large buffers with few (if any) braces.
* lisp/progmodes/cc-engine.el (c-get-fallback-scan-pos): Search a
maximum of
- 50,000 characters back for the two BODs. Return nil if we dont' find
them.
+ 50,000 characters back for the two BODs. Return nil if we don't find
them.
(c-parse-state-get-strategy): For strategy `forward', always use the
position
`good-pos' for `start-point', even when there's a change of current
macro.
Deal with a possible return value of nil from c-get-fallback-scan-pos
(as
@@ -50911,7 +50911,7 @@
2020-12-12 Lars Ingebrigtsen <larsi@gnus.org>
- Alter the "Redundant pcase patter" warning message
+ Alter the "Redundant pcase pattern" warning message
* lisp/emacs-lisp/pcase.el (pcase--expand): Make the "Redundant
pcase pattern" warning less vague (bug#31350).
@@ -54142,7 +54142,7 @@
Tweak the face of unknown backend indicators in flymake
* lisp/progmodes/flymake.el (flymake--mode-line-format): Don't put
- a face on the the "?" unknown backend indicator, because that
+ a face on the "?" unknown backend indicator, because that
looks odd in inactive windows (bug#44689).
2020-11-24 Paul W. Rankin <pwr@skeletons.cc>
@@ -55996,7 +55996,7 @@
2020-11-12 Andrea Corallo <akrl@sdf.org>
- Unline some functions to optimize bootstrap time
+ Uninline some functions to optimize bootstrap time
* lisp/emacs-lisp/comp.el (comp-mvar-value-vld-p)
(comp-mvar-value, comp-mvar-fixnum-p, comp-set-op-p)
@@ -56612,7 +56612,7 @@
2020-11-07 Andrea Corallo <akrl@sdf.org>
- Allow for manually bumbing new native compiler ABI versions
+ Allow for manually bumping new native compiler ABI versions
* src/comp.c (ABI_VERSION): Define macro.
(hash_native_abi): Include ABI_VERSION in the hashing.
@@ -61229,7 +61229,7 @@
2020-10-14 Andrea Corallo <akrl@sdf.org>
- Have `native-elisp-load' return the last registerd function
+ Have `native-elisp-load' return the last registered function
* lisp/emacs-lisp/comp.el (comp-emit-for-top-level): Synthesize
'top_level_run' so it returns the last value returned by
@@ -63478,7 +63478,7 @@
user-error when there's a wrong password (bug#43704).
(epa--wrong-password-p): New function.
(epa-file-insert-file-contents): Use it, and stash the error away
- for later signalling.
+ for later signaling.
* lisp/emacs-lisp/subr-x.el (if-let): Autoload.
@@ -65831,7 +65831,7 @@
Better error handling after calling 'gcc_jit_context_compile_to_file'
- Typically errors are catched in 'compile_function' but in case
+ Typically errors are caught in 'compile_function' but in case
libgccjit throw an error only afterwards while compiling the whole
compilation unit we have to report it correctly.
@@ -67774,7 +67774,7 @@
2020-09-05 Lars Ingebrigtsen <larsi@gnus.org>
- Revert "Display name with with spaces, but keep symbol name underneath"
+ Revert "Display name with spaces, but keep symbol name underneath"
This reverts commit e0c77bb62c1c950a82ea0517646d989dc5c1fe27.
@@ -67854,7 +67854,7 @@
2020-09-05 ej-32u <ej32u@protonmail.com> (tiny change)
- Display name with with spaces, but keep symbol name underneath
+ Display name with spaces, but keep symbol name underneath
* lisp/cus-edit.el (custom-unlispify-menu-entry): Display the
pretty name, but keep the real symbol name as the value (bug#41905).
@@ -73089,7 +73089,7 @@
* lisp/textmodes/tex-mode.el (tex-font-lock-keywords-2): End the
expression before the terminating $ in constructions like $\it
identifiername$
- (bug#28277). This avoids italicising the final $ character.
+ (bug#28277). This avoids italicizing the final $ character.
This fixes the final $ of the final test case here:
@@ -73421,7 +73421,7 @@
2020-08-08 Lars Ingebrigtsen <larsi@gnus.org>
- Modernise a code example in os.texi
+ Modernize a code example in os.texi
* doc/lispref/os.texi (Session Management): Use
with-current-buffer in the example instead of save+switch (bug#40341).
@@ -75687,7 +75687,7 @@
* lisp/net/eww.el (eww-list-bookmarks): Don't show buffer if there
are no bookmarks. (Bug#41385)
- (eww-bookmark-prepare): Move signalling an error if there are no
+ (eww-bookmark-prepare): Move signaling an error if there are no
bookmarks from here...
(eww-read-bookmarks): ...to here. Add new argument `error-out' to
control this.
@@ -75941,7 +75941,7 @@
2020-07-13 Andrea Corallo <akrl@sdf.org>
- Rework the backend to allocate arument arrays for call by references
+ Rework the backend to allocate argument arrays for call by references
* src/comp.c (comp_t): Add 'zero' field.
(emit_limple_call_ref): Allocate an array to host the parameters
@@ -76328,7 +76328,7 @@
Add a simple pass to infer pure functions not explicitly declared as
such. Use this information only during compilation (speed 3) to
- optimize out function calls whe possible.
+ optimize out function calls when possible.
2020-07-09 Andrea Corallo <akrl@sdf.org>
@@ -77634,7 +77634,7 @@
Add an initial implementation to support dynamic scope. Arg
parsing/binding it's done using the existing code in use for
- bytecode (no ad-hoc code is synthetized for that).
+ bytecode (no ad-hoc code is synthesized for that).
* src/lisp.h (struct Lisp_Subr): Add lambda_list field.
(SUBR_NATIVE_COMPILED_DYNP): New inliner.
@@ -78012,7 +78012,7 @@
cd4f75bb86 Rename default function to next-error-buffer-unnavigated-c...
1dff0a8949 * lisp/image-mode.el (image-toggle-display-image): Fix fit...
a71d1787f1 * doc/misc/tramp.texi (Predefined connection information):...
- 079b0dc430 Delete, don't kill, dir dir fragments in icomplete-fido-ba...
+ 079b0dc430 Delete, don't kill, dir fragments in icomplete-fido-ba...
6cdecc2659 Revert markup change in with-coding-priority docs
22f4fba8a9 * lisp/emulation/cua-rect.el (cua--rectangle-region-insert...
6b9eac6759 * lisp/simple.el (shell-command-on-region): Fix docstring.
@@ -78249,7 +78249,7 @@
(comp-latch-make-fill): New function.
(comp-emit-uncond-jump, comp-emit-cond-jump): Update to emit
latches.
- (comp-new-block-sym): Add a postfix paramenter.
+ (comp-new-block-sym): Add a postfix parameter.
2020-06-13 Andrea Corallo <akrl@sdf.org>
@@ -78602,7 +78602,7 @@
Fix comp-call-optim-form-call for null `callee'
* lisp/emacs-lisp/comp.el (comp-call-optim-form-call): Guard
- agains null `calle'.
+ against null `calle'.
2020-06-07 Glenn Morris <rgm@gnu.org>
@@ -79675,7 +79675,7 @@
Simply return the directory selected by the user.
(project-switch-project-find-file): Remove.
(project-switch-project-dired): Rename to project-dired and make
- it follow the convention of existing projec tcommands.
+ it follow the convention of existing project tcommands.
(project-switch-project-eshell): Ditto.
(project-switch-project): Instead of passing the project instance
to the command, just bind default-directory.
@@ -80910,7 +80910,7 @@
'lambda_gc_guard' 'lambda_c_name_idx_h' 'data_imp_relocs'
'loaded_once' fields.
- * src/comp.c (load_comp_unit): Use compilaiton unit 'loaded_once'
+ * src/comp.c (load_comp_unit): Use compilation unit 'loaded_once'
field.
(make_subr, Fcomp__register_lambda): New functions.
(Fcomp__register_subr): Make use of 'make_subr'.
@@ -81264,7 +81264,7 @@
Fix bug #40992 whilst still allowing breakpoint highlights in edebug
Strategy: when an instrumented function gets re-evaluated, save the
former
- value of its symbol's `edebug' property in the new propery
`ghost-edebug'. If
+ value of its symbol's `edebug' property in the new property
`ghost-edebug'. If
this function is still being edebugged, edebug will then access its
info from
this new property.
@@ -83843,7 +83843,7 @@
Implement position independent dump.
- Set the filename for every compilation unit as realtive to obtain a
+ Set the filename for every compilation unit as relative to obtain a
position independent dump.
* lisp/loadup.el: Modify filename for every compilation unit as
@@ -84397,7 +84397,7 @@
* lisp/arc-mode.el: Rewrite displaying the summaries
- Completely rewrite the code that displayes the summaries, so all
+ Completely rewrite the code that displays the summaries, so all
backends share the same code.
(archive--summarize-descs): New function.
@@ -86075,7 +86075,7 @@
Merge remote-tracking branch 'savannah/master' into HEAD
-2020-03-10 AndreaCorallo <akrl@sdf.org>
+2020-03-10 Andrea Corallo <akrl@sdf.org>
* Improve load_comp_unit
@@ -86084,7 +86084,7 @@
Guard also data_ephemeral_vec against compiler optimizations.
-2020-03-10 AndreaCorallo <akrl@sdf.org>
+2020-03-10 Andrea Corallo <akrl@sdf.org>
* Fix store_function_docstring for native functions
@@ -86098,7 +86098,7 @@
native_intspec and native_doc fields has to be reached by the subr
cause are not anymore in the CU.
-2020-03-10 AndreaCorallo <akrl@sdf.org>
+2020-03-10 Andrea Corallo <akrl@sdf.org>
* Set relocation class as ephemeral in `comp-limplify-top-level'
@@ -86547,17 +86547,17 @@
* lisp/replace.el (occur-1): Update default-directory in occur buffer.
-2020-03-04 AndreaCorallo <akrl@sdf.org>
+2020-03-04 Andrea Corallo <akrl@sdf.org>
* Do not crash if the output directory is created in the meanwhile
-2020-03-03 AndreaCorallo <akrl@sdf.org>
+2020-03-03 Andrea Corallo <akrl@sdf.org>
Hash eln ABI once and add it to the output compilation path
Fix org for eln new compilation folder layout
-2020-03-03 AndreaCorallo <akrl@sdf.org>
+2020-03-03 Andrea Corallo <akrl@sdf.org>
Rework `find-lisp-object-file-name'
@@ -86668,7 +86668,7 @@
and 'fill-column' values. (Bug#36837)
(whitespace-lines-regexp): New function.
-2020-03-01 AndreaCorallo <akrl@sdf.org>
+2020-03-01 Andrea Corallo <akrl@sdf.org>
* ; Clean-up out of date comment
@@ -86718,11 +86718,11 @@
* src/pdumper.c (dump_object): Fix hash for Lisp_Type after commit
202c3319a28c029d6971dccea92f92425c5e8067.
-2020-02-29 AndreaCorallo <akrl@sdf.org>
+2020-02-29 Andrea Corallo <akrl@sdf.org>
Introduce 'effective_load_path'
-2020-02-29 AndreaCorallo <akrl@sdf.org>
+2020-02-29 Andrea Corallo <akrl@sdf.org>
* Keep comp-subr-list into pure space
@@ -87689,7 +87689,7 @@
(lispref/modes.texi): Explain avoiding lambdas on hooks.
-2020-02-06 AndreaCorallo <akrl@sdf.org>
+2020-02-06 Andrea Corallo <akrl@sdf.org>
Add system-configuration in the compilation output path
@@ -87713,7 +87713,7 @@
Add function ssa-status as `comp-func' slot and have `comp-clean-ssa'
to run when necessary.
-2020-03-01 AndreaCorallo <akrl@sdf.org>
+2020-03-01 Andrea Corallo <akrl@sdf.org>
Remove relocation index form LIMPLE setimm
@@ -87739,21 +87739,21 @@
Merge remote-tracking branch 'savannah/master' into HEAD
-2020-02-26 AndreaCorallo <akrl@sdf.org>
+2020-02-26 Andrea Corallo <akrl@sdf.org>
* ; Add a TODO for a future optimization
-2020-02-26 AndreaCorallo <akrl@sdf.org>
+2020-02-26 Andrea Corallo <akrl@sdf.org>
Store optimize qualities into .eln files
For now just comp-speed and comp-debug are stored.
-2020-02-26 AndreaCorallo <akrl@sdf.org>
+2020-02-26 Andrea Corallo <akrl@sdf.org>
- Rename d-base allocation classe into d-default
+ Rename d-base allocation class into d-default
-2020-02-26 AndreaCorallo <akrl@sdf.org>
+2020-02-26 Andrea Corallo <akrl@sdf.org>
Add ephemeral relocation data class
@@ -87793,7 +87793,7 @@
Test 'comp-eq' should not assume any string hashing policy
-2020-02-21 AndreaCorallo <akrl@sdf.org>
+2020-02-21 Andrea Corallo <akrl@sdf.org>
Emit 'top_level_run' objects as impure
@@ -87801,7 +87801,7 @@
Verify '--with-nativecomp' has also '--with-dumping=pdumper'
-2020-02-21 AndreaCorallo <akrl@sdf.org>
+2020-02-21 Andrea Corallo <akrl@sdf.org>
Reorder m-var slots
@@ -87819,7 +87819,7 @@
Use `sxhash-eq' to generate mvar SSA ids
-2020-02-15 AndreaCorallo <akrl@sdf.org>
+2020-02-15 Andrea Corallo <akrl@sdf.org>
Speed 2 goes default
@@ -87832,7 +87832,7 @@
Every function call by reference gets use one unique array of
arguments.
-2020-02-14 AndreaCorallo <akrl@sdf.org>
+2020-02-14 Andrea Corallo <akrl@sdf.org>
Clean-up old gc disable refuse in comp-tests-non-locals
@@ -88071,7 +88071,7 @@
Always define subr-native-elisp-p also without native compiler
-2020-02-03 AndreaCorallo <akrl@sdf.com>
+2020-02-03 Andrea Corallo <akrl@sdf.com>
Fix load_comp_unit for non zero speeds
@@ -90740,7 +90740,7 @@
compute dominator tree
- ssa and endge number generation with generator
+ ssa and edge number generation with generator
add edge computation
@@ -91228,7 +91228,7 @@
optimize primitive native call
- propagate contant types and optimize self calls
+ propagate constant types and optimize self calls
introduce stack_el_t
@@ -91466,7 +91466,7 @@
introduce CASE_CALL_NARGS macro and add various ops
- symbol_function set fset fget fget Bsubstring
+ symbol_function set fset fget Bsubstring
2020-01-01 Andrea Corallo <andrea_corallo@yahoo.it>
@@ -93578,7 +93578,7 @@
2021-02-03 Michael Albinus <michael.albinus@gmx.de>
- Fix an error in tramp-sh-handle-make-process. Dont' merge with master
+ Fix an error in tramp-sh-handle-make-process. Don't merge with master
* lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Don't use heredoc
script whent the argument contains a string.
@@ -95039,7 +95039,7 @@
2020-06-13 João Távora <joaotavora@gmail.com>
- Delete, don't kill, dir dir fragments in icomplete-fido-backward-updir
+ Delete, don't kill, dir fragments in icomplete-fido-backward-updir
Reported by: Andrew Schwartzmeyer <andrew@schwartzmeyer.com>
@@ -101413,7 +101413,7 @@
vc-hg: prompt for branch to merge
* lisp/vc/vc-hg.el (vc-hg-merge-branch): Prompt for revision to merge.
- (vc-hg-revision-table): Use branches, tags and bookmarks as competion
+ (vc-hg-revision-table): Use branches, tags and bookmarks as completion
candidates.
* etc/NEWS: Mention changes of vc-hg.el
@@ -101483,7 +101483,7 @@
(Create_Pixmap_From_Bitmap_Data):
(xpm_load): Use new function.
* src/xterm.c (x_composite_image): Use PictOpOver when there is a mask
- so the transparency is honoured.
+ so the transparency is honored.
(x_draw_image_foreground_1): Use x_composite_image.
2019-11-29 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -103042,7 +103042,7 @@
open-paren-in-column-0-is-defun-start to nil) fixes bug #37910. It may
also
have fixed bug #5490 and bug #18072.
- * lisp/progmodes/cc-engine.el (c-state-cache-non-literal-place): Remove
thi
+ * lisp/progmodes/cc-engine.el (c-state-cache-non-literal-place): Remove
this
non-sensical function, replacing it with ....
(c-state-cache-lower-good-pos): New function.
(c-renarrow-state-cache, c-append-lower-brace-pair-to-state-cache)
@@ -110631,7 +110631,7 @@
Fix reversed check in mm-possibly-verify-or-decrypt
* lisp/gnus/mm-decode.el (mm-possibly-verify-or-decrypt): Fix
- reverse check thinko that made unverified singed messages not
+ reverse check thinko that made unverified signed messages not
display correctly.
2019-09-27 Wilson Snyder <wsnyder@wsnyder.org>
@@ -113664,7 +113664,7 @@
Make the NSM not pop up an X dialogue on non-mouse actions
* lisp/emacs-lisp/rmc.el (read-multiple-choice): Don't pop up X
- dialogues on (url-retrieve "https://expired.badssl.com/"; #'ignore)
+ dialogs on (url-retrieve "https://expired.badssl.com/"; #'ignore)
and the like.
2019-09-04 Lars Ingebrigtsen <larsi@gnus.org>
@@ -115157,7 +115157,7 @@
2019-08-21 Lars Ingebrigtsen <larsi@gnus.org>
- Make hide-ifdef-mode-prefix-key customisable
+ Make hide-ifdef-mode-prefix-key customizable
* lisp/progmodes/hideif.el (hide-ifdef-mode-prefix-key): Make into
a defcustom since it seems like this is something that should be
@@ -117900,7 +117900,7 @@
(readbyte_from_file): Assert that `infile` is set.
(close_infile_unwind): Reset `infile` to its previous value rather than
to NULL.
- (Fload): Remember the previous value of `infile` before chaning it.
+ (Fload): Remember the previous value of `infile` before changing it.
(readevalloop): Don't set `infile` any more.
2019-07-31 Paul Eggert <eggert@cs.ucla.edu>
@@ -118316,7 +118316,7 @@
* lisp/mh-e/mh-speed.el (mh-speed-parse-flists-output):
* lisp/mh-e/mh-search.el (mh-index-parse-search-regexp): Avoid
- warning about `values-list' by using `cl-values-list' insead.
+ warning about `values-list' by using `cl-values-list' instead.
2019-07-29 Lars Ingebrigtsen <larsi@gnus.org>
@@ -126255,7 +126255,7 @@
Suppress warning about non-prefixed variable in mailalias.el
- * lisp/mail/mailalias.el (patters): Suppress warning about
+ * lisp/mail/mailalias.el (pattern): Suppress warning about
non-prefixed variable used by `mail-complete-alist'.
2019-06-15 Lars Ingebrigtsen <larsi@gnus.org>
@@ -130261,7 +130261,7 @@
8192 bytes is a reasonable number nowadays given typical file
system design.
* test/lisp/image-tests.el (image-tests--emacs-images-directory):
- New contant.
+ New constant.
(image-type-from-file-header-test): New test.
2019-05-18 Michael Albinus <michael.albinus@gmx.de>
@@ -130524,7 +130524,7 @@
2019-05-16 Lars Ingebrigtsen <larsi@gnus.org>
- Avoind string-as-multibyte in ps-output-string-prim
+ Avoid string-as-multibyte in ps-output-string-prim
* lisp/ps-print.el (ps-output-string-prim): Avoid
`string-as-multibyte', and encode as utf-8 instead if multibyte.
@@ -130710,7 +130710,7 @@
Fix diff-mode face problem when used in terminals (Bug#35695)
In a terminal supporting 256 colors, both diff-added and diff-removed
- was mapped to the same greyish color.
+ was mapped to the same grayish color.
* lisp/vc/diff-mode.el: Modify the colors of diff-removed,
diff-added, diff-refine-removed, and diff-refine-added when
@@ -136480,7 +136480,7 @@
Check gnus-newsgroup-dependencies is hash table in gnus-id-to-thread
* lisp/gnus/gnus-sum.el (gnus-id-to-thread): If dependencies haven't
- been initialized yet, don't blow up. Mimicks previous (non hasht
+ been initialized yet, don't blow up. Mimics previous (non hash
table) behavior.
2019-03-31 Mattias Engdegård <mattiase@acm.org>
@@ -140170,7 +140170,7 @@
* doc/misc/eshell.texi (Built-ins): Fix alias description
- Dear eamcs developers, eshells current documentation first states
+ Dear emacs developers, eshell's current documentation first states
that alias definitions are not saved to an alias file, later that
they are saved to an alias file. I tested it and the latter is
correct.
@@ -156879,7 +156879,7 @@
Merge from origin/emacs-26
90bea37 ; * etc/PROBLEMS: Fix fvwm version number in last commit
- af82d1f * etc/PROBLEMS: Document stickyness problem with FVWM (Bug#31...
+ af82d1f * etc/PROBLEMS: Document stickiness problem with FVWM (Bug#31...
4a3aed2 Update Emacs Lisp Intro to match current behavior
21f2247 Merge branch 'emacs-26' of git.savannah.gnu.org:/srv/git/emac...
3257085 Fix previous commit
@@ -158744,7 +158744,7 @@
2018-04-17 Basil L. Contovounesios <contovob@tcd.ie>
- Modernise face specs and set version tags in eww/shr
+ Modernize face specs and set version tags in eww/shr
* lisp/net/shr.el (shr-strike-through, shr-link, shr-selected-link):
Set :version tag (bug#31200).
@@ -159218,10 +159218,10 @@
2018-04-14 Lars Ingebrigtsen <larsi@gnus.org>
- Modernise a Gnus function a bit
+ Modernize a Gnus function a bit
* lisp/gnus/gnus-start.el (gnus-update-active-hashtb-from-killed):
- Modernise code a bit.
+ Modernize code a bit.
2018-04-14 Lars Ingebrigtsen <larsi@gnus.org>
@@ -165960,7 +165960,7 @@
cl-loop: Calculate the array length just once
* lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause):
- Dont calculate the array length on each iteration (Bug#29866).
+ Don't calculate the array length on each iteration (Bug#29866).
2018-01-07 Philipp Stephani <phst@google.com>
@@ -166738,7 +166738,7 @@
5a7d009 * lisp/vc/smerge-mode.el (smerge-refine): Replace obsolete al...
e019c35 FOR_EACH_FRAME no longer assumes frame-list
d64b88d * src/font.c (Ffont_info): Doc fix. (Bug#29682)
- 92b2604 Modernise message.el face spec syntax
+ 92b2604 Modernize message.el face spec syntax
b1efbe6 Update message.el obsolete face aliases
2494c14 ; * lisp/comint.el (comint-terminfo-terminal): Add a :version...
12ad276 Improve documentation of TERM environment variable
@@ -167034,7 +167034,7 @@
5a7d0095a4 * lisp/vc/smerge-mode.el (smerge-refine): Replace obsolete...
e019c35df6 FOR_EACH_FRAME no longer assumes frame-list
d64b88da2f * src/font.c (Ffont_info): Doc fix. (Bug#29682)
- 92b2604a7f Modernise message.el face spec syntax
+ 92b2604a7f Modernize message.el face spec syntax
b1efbe6564 Update message.el obsolete face aliases
2494c14e76 ; * lisp/comint.el (comint-terminfo-terminal): Add a :vers...
12ad276d15 Improve documentation of TERM environment variable
@@ -169297,7 +169297,7 @@
2e1b3522b8 Improve documentation of 'line-number-display-width'
5b6e59cfdb Implement vc-default-dir-extra-headers for vc-rcs
22adeca42a In NEWS give advice on use of `switch-to-buffer' (Bug#28645)
- 2c3e6f1ddc Dont update primary selection with winner-undo
+ 2c3e6f1ddc Don't update primary selection with winner-undo
b38724ab67 Work around ImageMagick bug 825
20cc68e871 Document rectangle-preview option more (Bug#27974)
a0b7b301dd Do not reject https://gnu.org in commit messages
@@ -172340,7 +172340,7 @@
* doc/misc/eshell.texi (Built-ins): Fix alias description
- Dear eamcs developers, eshells current documentation first states
+ Dear emacs developers, eshell's current documentation first states
that alias definitions are not saved to an alias file, later that
they are saved to an alias file. I tested it and the latter is
correct.
@@ -176909,7 +176909,7 @@
2018-06-02 Martin Rudalics <rudalics@gmx.at>
- * etc/PROBLEMS: Document stickyness problem with FVWM (Bug#31650)
+ * etc/PROBLEMS: Document stickiness problem with FVWM (Bug#31650)
2018-06-01 Eli Zaretskii <eliz@gnu.org>
@@ -181827,7 +181827,7 @@
2017-12-15 Basil L. Contovounesios <contovob@tcd.ie>
- Modernise message.el face spec syntax
+ Modernize message.el face spec syntax
* lisp/gnus/message.el (message-header-to, message-header-cc)
(message-header-subject, message-header-newsgroups)
@@ -184352,7 +184352,7 @@
* src/lisp.h (COMMON_MULTIPLE): Move here from alloc.c.
* src/thread.c (THREAD_ALIGNMENT): New macro.
- (main_thread): Use THREAD_ALIGNMENT to align propertly. (Bug#29040)
+ (main_thread): Use THREAD_ALIGNMENT to align properly. (Bug#29040)
2017-10-28 Eli Zaretskii <eliz@gnu.org>
@@ -185296,10 +185296,10 @@
2017-10-17 Tino Calancha <tino.calancha@gmail.com>
Noam Postavsky <npostavs@gmail.com>
- Dont update primary selection with winner-undo
+ Don't update primary selection with winner-undo
* lisp/winner.el (winner-set):
- Dont update primary selection when select-enable-primary
+ Don't update primary selection when select-enable-primary
is non-nil (Bug#28631).
2017-10-17 Paul Eggert <eggert@cs.ucla.edu>
@@ -185373,7 +185373,7 @@
* lisp/image.el (image-type-header-regexps):
Allow two or more CRs or LFs in initial whitespace sequences. See:
- http://netpbm.sourceforge.net/doc/pbm.html
+ https://netpbm.sourceforge.net/doc/pbm.html
2017-10-16 Paul Eggert <eggert@cs.ucla.edu>
@@ -185648,7 +185648,7 @@
Add mode map to Flymake diagnostic button
* lisp/progmodes/flymake.el (flymake--diagnostics-buffer-entries): Add
- keymap propery.
+ keymap property.
2017-10-10 João Távora <joaotavora@gmail.com>
@@ -192051,7 +192051,7 @@
2017-08-09 Tino Calancha <tino.calancha@gmail.com>
- Ask files for deletion in buffer order: top first, botton later
+ Ask files for deletion in buffer order: top first, bottom later
* lisp/dired.el (dired-do-flagged-delete, dired-do-delete):
Call `nreverse' t invert the output of `dired-map-over-marks'.
@@ -194580,7 +194580,7 @@
2017-07-09 R. Bernstein <rocky@gnu.org>
- Add realgud faces faces to whiteboard...
+ Add realgud faces to whiteboard...
Adjust wheatgrass to use underline for enabled/disabled breakpoints
@@ -195520,7 +195520,7 @@
Ignore mouse-movement for describe-key-briefly (Bug#12204)
- * lisp/help.el (help-read-key-sequence): Add optional argument ot
+ * lisp/help.el (help-read-key-sequence): Add optional argument to
ignore `mouse-movement' events.
(describe-key-briefly): Use it.
* doc/emacs/help.texi (Key Help):
@@ -197097,7 +197097,7 @@
Clang on macOS warns about these with -Wtautological-compare. POSIX
guarantees that rlim_t is
unsigned (cf.
-
http://pubs.opengroup.org/onlinepubs/009695399/basedefs/sys/resource.h.html),
+
https://pubs.opengroup.org/onlinepubs/009695399/basedefs/sys/resource.h.html),
so these resource limits can never be negative.
* src/emacs.c (main): Remove tautological comparisons.
@@ -198690,7 +198690,7 @@
(tramp-adb-ls-toolbox-regexp):
Ignore addition links column on Android 7.
(tramp-adb-get-ls-command):
- Dont use --color=none when using toybox (Android 7). It's not
+ Don't use --color=none when using toybox (Android 7). It's not
possible to disable coloring explicitly for toybox ls.
2017-05-27 Svante Carl v. Erichsen <Svante.v.Erichsen@web.de> (tiny change)
@@ -199186,7 +199186,7 @@
2017-05-23 Paul Eggert <eggert@cs.ucla.edu>
- Don't warn about missing brances on macOS
+ Don't warn about missing branches on macOS
On macOS, removing -Wmissing-braces is not enough; the warning has to
be disabled explicitly.
@@ -199197,7 +199197,7 @@
' is commonly used as an apostrophe in the prose sections of spec
files, which was erroneously highlighted as strings. See for example
- http://kmymoney2.sourceforge.net/phb/rpm-example.html
+ https://kmymoney2.sourceforge.net/phb/rpm-example.html
* lisp/progmodes/sh-script.el (sh-mode-syntax-table): Treat ' as
punctuation in RPM spec files.
@@ -208945,7 +208945,7 @@
Revamp quitting and fix infloops
- This fixes some infinite loops that cannot be quitted out of,
+ This fixes some infinite loops that cannot be quit out of,
e.g., (defun foo () (nth most-positive-fixnum '#1=(1 . #1#)))
when byte-compiled and when run under X. See:
https://lists.gnu.org/r/emacs-devel/2017-01/msg00577.html
@@ -214158,7 +214158,7 @@
refactor systhread.h
This refactors systhread.h to move the notion of a "lisp mutex"
- into thread.c. This lets us make make the global lock and
+ into thread.c. This lets us make the global lock and
post_acquire_global_lock static.
2012-08-17 Tom Tromey <tromey@redhat.com>
@@ -218796,7 +218796,7 @@
* lib/stdint.in.h, m4/extensions.m4, m4/stdint.m4, m4/stdio_h.m4:
* m4/sys_types_h.m4: Copy from gnulib.
* lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate.
- * lib/limits.in.h, m4/limits-h.m4: New files, copie from gnulib.
+ * lib/limits.in.h, m4/limits-h.m4: New files, copied from gnulib.
* nt/gnulib.mk: Merge changes from lib/gnulib.mk.
2016-09-15 Michael Albinus <michael.albinus@gmx.de>
@@ -219462,7 +219462,7 @@
2016-09-02 Stefan Monnier <monnier@iro.umontreal.ca>
- Check actual contents before promting about changed file
+ Check actual contents before prompting about changed file
* lisp/userlock.el (userlock--check-content-unchanged)
(userlock--ask-user-about-supersession-threat): New functions.
@@ -220696,7 +220696,7 @@
* lisp/progmodes/cc-mode.el (c-after-change): When we detect a missing
invocation of c-before-change-functions, we assume the changed region
is the
- entire buffer, and call c-before-change explicitly before proceding.
+ entire buffer, and call c-before-change explicitly before proceeding.
2016-08-09 Alan Mackenzie <acm@muc.de>
@@ -221327,8 +221327,8 @@
is never used. Hardcode the syntax so that the compilar can detect such
dead code and remove it from compiled code.
- The only exception is RE_NO_POSIX_BACKTRACKING which can be separatelly
- specified. Handle this separatelly with a function argument (replacing
+ The only exception is RE_NO_POSIX_BACKTRACKING which can be separately
+ specified. Handle this separately with a function argument (replacing
now unnecessary syntax argument).
With this patchset, size of Emacs binary on x86_64 machine is reduced by
@@ -223962,10 +223962,10 @@
2016-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
- Advertize set-keymap-parent as replacement for copy-keymap
+ Advertise set-keymap-parent as replacement for copy-keymap
* doc/lispref/keymaps.texi (Creating Keymaps):
- * src/keymap.c (Fcopy_keymap): Advertize set-keymap-parent as
replacement.
+ * src/keymap.c (Fcopy_keymap): Advertise set-keymap-parent as
replacement.
2016-06-15 Ted Zlatanov <tzz@lifelogs.com>
@@ -226537,7 +226537,7 @@
Fix Bug#10085
* lisp/net/tramp.el (tramp-find-foreign-file-name-handler):
- Add optional arguments OPERATION and COMPETION. Handle
+ Add optional arguments OPERATION and COMPLETION. Handle
`file-name-as-directory', `file-name-directory' and
`file-name-nondirectory' also in completion mode.
(tramp-file-name-handler): Use it. (Bug#10085)
@@ -226854,7 +226854,7 @@
2016-04-30 Lars Ingebrigtsen <larsi@gnus.org>
- Document mode mode line variables
+ Document mode line variables
* doc/lispref/modes.texi (Mode Line Variables): Document
`mode-line-front-space, `mode-line-misc-info',
@@ -227546,7 +227546,7 @@
of the data end marker from here... (bug#23020).
(smtpmail-send-data): ... to here, so that we don't get a
"Sending done" before we've sent the final "." (which can make
- the SMPT server reject the email.
+ the SMTP server reject the email.
2016-04-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -227801,7 +227801,7 @@
* lisp/auth-source.el
(auth-source-macos-keychain-search-items): Handle keychain
- output correctly when has special chararcters (bug#22824).
+ output correctly when has special characters (bug#22824).
2016-04-24 Magnus Henoch <magnus.henoch@gmail.com>
diff --git a/INSTALL b/INSTALL
index 95d2dbda80..c0323f770b 100644
--- a/INSTALL
+++ b/INSTALL
@@ -187,7 +187,7 @@ X11 is being used.
libz (for PNG): https://www.zlib.net/
X libjpeg for JPEG: https://www.ijg.org/
X libtiff for TIFF: http://www.simplesystems.org/libtiff/
- X libgif for GIF: http://giflib.sourceforge.net/
+ X libgif for GIF: https://giflib.sourceforge.net/
librsvg2 for SVG: https://wiki.gnome.org/Projects/LibRsvg
libwebp for WebP: https://developers.google.com/speed/webp/
diff --git a/Makefile.in b/Makefile.in
index 741a4c5538..93609a4e16 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -52,14 +52,14 @@
# make bootstrap
# Removes all the compiled files to force a new bootstrap from a
# clean slate, and then build in the normal way. If the FAST Make
-# variable is set, then the config.cache file isn't removed. This
-# allows you to say
+# variable is set, then the autom4te.cache directory and the
+# config.cache file are not removed. This lets you say
#
# ./configure -C
# make FAST=true bootstrap
#
# and use the cached results from the configure run, which is much
-# faster.
+# faster though it does not work in general.
#
# make docs
# Make Emacs documentation files from their sources; requires makeinfo.
@@ -405,16 +405,18 @@ actual-all: ${SUBDIR} info
$(gsettings_SCHEMAS:.xml=.valid) src-depending-on-lis
# ADVICE-ON-FAILURE-END:bootstrap
advice-on-failure:
+ @[ -f .no-advice-on-failure ] && exit ${exit-status}; true
@echo >&2 '***'
@echo >&2 '*** '"\"make ${make-target}\" failed with exit status
${exit-status}."
@echo >&2 '***'
@cat Makefile | \
- sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^#
ADVICE-ON-FAILURE-END:${make-target}/q};' | \
- sed 's/^# /*** /' | grep -v '^*** ADVICE-ON-FAILURE-' >&2
+ sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^#
ADVICE-ON-FAILURE-END:${make-target}/q;};' | \
+ sed 's/^# /*** /' | grep -v '^\*\*\* ADVICE-ON-FAILURE-' >&2
@echo >&2 '***'
@exit ${exit-status}
sanity-check:
+ @[ -f .no-advice-on-failure ] && exit 0; true
@v=$$(src/emacs${EXEEXT} --batch --eval \
'(progn (defun f (n) (if (= 0 n) 1 (* n (f (- n 1))))) (princ (f
10)))' \
2> /dev/null); \
@@ -423,8 +425,8 @@ sanity-check:
echo >&2 '*** '"\"make ${make-target}\" succeeded, but Emacs is not
functional."; \
echo >&2 '***'; \
cat Makefile | \
- sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^#
ADVICE-ON-FAILURE-END:${make-target}/q};' | \
- sed 's/^# /*** /' | grep -v '^*** ADVICE-ON-FAILURE-' >&2; \
+ sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^#
ADVICE-ON-FAILURE-END:${make-target}/q;};' | \
+ sed 's/^# /*** /' | grep -v '^\*\*\* ADVICE-ON-FAILURE-' >&2; \
echo >&2 '***'; \
exit 1
@@ -530,6 +532,11 @@ lisp: src
lib lib-src lisp nt: Makefile
$(MAKE) -C $@ all
+trampolines: src lisp
+ifeq ($(HAVE_NATIVE_COMP),yes)
+ $(MAKE) -C lisp trampolines
+endif
+
# Pass an unexpanded $srcdir to src's Makefile, which then
# expands it using its own value of srcdir (which points to the
# source directory of src/).
@@ -1035,7 +1042,7 @@ bootstrap-clean: $(distclean_dirs:=_bootstrap-clean)
rm -f ${srcdir}/etc/refcards/emacsver.tex
rm -rf native-lisp/ lisp/leim/ja-dic/
ifndef FAST
- rm -f config.cache
+ rm -fr autom4te.cache config.cache
endif
${top_bootclean}
diff --git a/admin/authors.el b/admin/authors.el
index 12fe25fa4e..fd8ba9cb01 100644
--- a/admin/authors.el
+++ b/admin/authors.el
@@ -990,7 +990,7 @@ in the repository.")
;; to how a file was mentioned in the respective ChangeLog. It is
;; advisable to run a Grep command such as
;;
-;; fgrep -R BASENAME . --include='ChangeLog*'
+;; grep -F -R BASENAME . --include='ChangeLog*'
;;
;; where BASENAME is the old basename of the renamed file. This will
;; show all the different reference forms of the file in the various
diff --git a/admin/automerge b/admin/automerge
index c7c17dfb5e..d2c92948e1 100755
--- a/admin/automerge
+++ b/admin/automerge
@@ -35,18 +35,7 @@
## it with the -d option in the repository directory, in case a pull
## updates this script while it is working.
-set -o nounset
-
-die () # write error to stderr and exit
-{
- [ $# -gt 0 ] && echo "$PN: $*" >&2
- exit 1
-}
-
-PN=${0##*/} # basename of script
-PD=${0%/*}
-
-[ "$PD" = "$0" ] && PD=. # if PATH includes PWD
+source "${0%/*}/emacs-shell-lib"
usage ()
{
@@ -129,13 +118,7 @@ OPTIND=1
[ "$test" ] && build=1
-if [ -x "$(command -v mktemp)" ]; then
- tempfile=$(mktemp "/tmp/$PN.XXXXXXXXXX")
-else
- tempfile=/tmp/$PN.$$
-fi
-
-trap 'rm -f $tempfile 2> /dev/null' EXIT
+tempfile="$(emacs_mktemp)"
[ -e Makefile ] && [ "$build" ] && {
@@ -263,5 +246,3 @@ git push || die "push error"
exit 0
-
-### automerge ends here
diff --git a/admin/charsets/mapfiles/stdenc.txt
b/admin/charsets/mapfiles/stdenc.txt
index e39486a319..1c898bac0b 100644
--- a/admin/charsets/mapfiles/stdenc.txt
+++ b/admin/charsets/mapfiles/stdenc.txt
@@ -54,7 +54,7 @@
#
# [v0.1, 5 May 1995] First release.
#
-# Use the Unicode reporting form <http://www.unicode.org/reporting.html>
+# Use the Unicode reporting form <https://www.unicode.org/reporting.html>
# for any questions or comments or to report errors in the data.
#
0020 20 # SPACE # space
diff --git a/admin/charsets/mapfiles/symbol.txt
b/admin/charsets/mapfiles/symbol.txt
index b98baf6cf0..0a5aac8b61 100644
--- a/admin/charsets/mapfiles/symbol.txt
+++ b/admin/charsets/mapfiles/symbol.txt
@@ -57,7 +57,7 @@
#
# [v0.1, 5 May 1995] First release.
#
-# Use the Unicode reporting form <http://www.unicode.org/reporting.html>
+# Use the Unicode reporting form <https://www.unicode.org/reporting.html>
# for any questions or comments or to report errors in the data.
#
0020 20 # SPACE # space
diff --git a/admin/cus-test.el b/admin/cus-test.el
index 22d5a3a151..7e73f2e44a 100644
--- a/admin/cus-test.el
+++ b/admin/cus-test.el
@@ -131,7 +131,7 @@ Names should be as they appear in loaddefs.el.")
;; Don't create a file `abbrev-file-name'.
(setq save-abbrevs nil)
-;; Avoid compile logs from adviced functions.
+;; Avoid compile logs from advised functions.
(eval-after-load "bytecomp"
'(setq ad-default-compilation-action 'never))
diff --git a/admin/diff-tar-files b/admin/diff-tar-files
index 6ab39eab2f..869c942150 100755
--- a/admin/diff-tar-files
+++ b/admin/diff-tar-files
@@ -1,4 +1,4 @@
-#! /bin/sh
+#!/bin/bash
# Copyright (C) 2001-2022 Free Software Foundation, Inc.
@@ -17,6 +17,7 @@
# You should have received a copy of the GNU General Public License
# along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+source "${0%/*}/emacs-shell-lib"
if [ $# != 2 ]; then
cat <<EOF
@@ -31,9 +32,8 @@ fi
old_tar=$1
new_tar=$2
-old_tmp=/tmp/old.$$
-new_tmp=/tmp/new.$$
-trap "rm -f $old_tmp $new_tmp; exit 1" 1 2 15
+old_tmp="$(emacs_mktemp ${PN}-old)"
+new_tmp="$(emacs_mktemp ${PN}-new)"
tar tf "$old_tar" | sed -e 's,^[^/]*,,' | sort > $old_tmp
tar tf "$new_tar" | sed -e 's,^[^/]*,,' | sort > $new_tmp
diff --git a/admin/emacs-shell-lib b/admin/emacs-shell-lib
new file mode 100644
index 0000000000..750f81e057
--- /dev/null
+++ b/admin/emacs-shell-lib
@@ -0,0 +1,87 @@
+#!/bin/bash
+### emacs-shell-lib - shared code for Emacs shell scripts
+
+## Copyright (C) 2022 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:
+
+# Set an explicit umask.
+umask 077
+
+# Treat unset variables as an error.
+set -o nounset
+
+# Exit immediately on error.
+set -o errexit
+
+# Avoid non-standard command output from non-C locales.
+unset LANG LC_ALL LC_MESSAGES
+
+PN=${0##*/} # basename of script
+PD=${0%/*} # script directory
+
+[ "$PD" = "$0" ] && PD=. # if PATH includes PWD
+
+die () # write error to stderr and exit
+{
+ [ $# -gt 0 ] && echo "$PN: $@" >&2
+ exit 1
+}
+
+emacs_tempfiles=()
+
+emacs_tempfiles_cleanup ()
+{
+ for file in ${emacs_tempfiles[@]}; do
+ rm -f "${file}" 2> /dev/null
+ done
+}
+
+trap '
+ ret=$?
+ emacs_tempfiles_cleanup
+ exit $ret
+' EXIT
+
+emacs_mktemp ()
+{
+ local readonly file="${1-}"
+ local tempfile
+ local prefix
+
+ if [ -z "$file" ]; then
+ prefix="$PN"
+ else
+ prefix="$1"
+ fi
+
+ if [ -x "$(command -v mktemp)" ]; then
+ tempfile=$(mktemp "${TMPDIR-/tmp}/${prefix}.XXXXXXXXXX")
+ else
+ tempfile="${TMPDIR-/tmp}/${prefix}.$RANDOM$$"
+ (umask 077 && touch "$tempfile")
+ fi
+
+ [ -z "${tempfile}" ] && die "Creating temporary file failed"
+
+ emacs_tempfiles+=("${tempfile}")
+
+ echo "$tempfile"
+}
diff --git a/admin/emake b/admin/emake
index e2f38501e9..09f7410779 100755
--- a/admin/emake
+++ b/admin/emake
@@ -1,5 +1,22 @@
#!/bin/bash
+# Copyright (C) 2022 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/>.
+
# This script is meant to be used as ./admin/emake, and will compile
# the Emacs tree with virtually all of the informational messages
# removed, and with errors/warnings highlighted in red. It'll give a
diff --git a/admin/git-bisect-start b/admin/git-bisect-start
new file mode 100755
index 0000000000..cf0c8cde41
--- /dev/null
+++ b/admin/git-bisect-start
@@ -0,0 +1,40 @@
+#!/bin/bash
+
+### Start a git bisection, and prune the branches that are the result of
+### merging external trees into the Emacs repository.
+
+## Copyright (C) 2022 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:
+
+## Marking the last commits of external tree merges as "good" ensures
+## that all the commits between the external tree root and the merge
+## (excluding the merge-commit itself) are regarded as "good", so "git
+## bisect" will never descend into these branches, which only have the
+## files of the external tree, and in which Emacs can therefore not be
+## built. The last commit is the parent of the merge commit in the
+## external tree, that is, the parent of the merge commit that is not
+## on master.
+
+### Code:
+
+git bisect start
+
+# Prune commits 1e5b753bf4..806734c1b1 introduced by 0186faf2a1 (Eglot
+# merge on Oct 20 2022)
+git bisect good 806734c1b1f433de43d59d9a5e3a1e89d64315f6
diff --git a/admin/grammars/srecode-template.wy
b/admin/grammars/srecode-template.wy
index c3531ebd54..7ba73d2921 100644
--- a/admin/grammars/srecode-template.wy
+++ b/admin/grammars/srecode-template.wy
@@ -126,7 +126,7 @@ variable
: SET symbol insertable-string-list newline
(VARIABLE-TAG $2 nil $3)
| SET symbol number newline
- ;; This so a common error w/ priority works.
+ ;; This so a common error with priority works.
;; Note that "number" still has a string value in the lexer.
(VARIABLE-TAG $2 nil (list $3))
| SHOW symbol newline
diff --git a/admin/last-chance.el b/admin/last-chance.el
index 30d6a25a28..45d470cacd 100644
--- a/admin/last-chance.el
+++ b/admin/last-chance.el
@@ -41,7 +41,7 @@
;;
;; will show you any references to `change-log-date-face' in the
;; *.el files in a new buffer (in Grep mode). Hopefully you see
-;; only the obsolete declaration and can proceed w/ its removal.
+;; only the obsolete declaration and can proceed with its removal.
;; If not, please DTRT and refrain from the removal until those
;; references are properly transitioned.
;;
diff --git a/admin/make-manuals b/admin/make-manuals
index cb0c00a423..a252bf20f1 100755
--- a/admin/make-manuals
+++ b/admin/make-manuals
@@ -33,15 +33,7 @@
### Code:
-set -o nounset
-
-die () # write error to stderr and exit
-{
- [ $# -gt 0 ] && echo "$PN: $@" >&2
- exit 1
-}
-
-PN=${0##*/} # basename of script
+source "${0%/*}/emacs-shell-lib"
usage ()
{
@@ -96,8 +88,7 @@ OPTIND=1
[ -e admin/admin.el ] || die "admin/admin.el not found"
-tempfile=/tmp/$PN.$$
-trap "rm -f $tempfile 2> /dev/null" EXIT
+tempfile="$(emacs_mktemp)"
[ "$continue" ] || rm -rf $outdir
diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt
index 9a406b24fa..d881b81612 100644
--- a/admin/make-tarball.txt
+++ b/admin/make-tarball.txt
@@ -390,7 +390,7 @@ Next, regenerate the various manuals in HTML, PDF, and PS
formats:
Now change to the 'manual' directory and invoke upload-manuals:
- ../admin/updload-manuals /path/to/webpages/cvs/checkout
+ ../admin/upload-manuals /path/to/webpages/cvs/checkout
where /path/to/webpages/cvs/checkout is the place where you have the
CVS checkout of the Emacs Web pages, with subdirectories 'manual'
diff --git a/admin/notes/bug-triage b/admin/notes/bug-triage
index 3d9a275c9d..bee7242337 100644
--- a/admin/notes/bug-triage
+++ b/admin/notes/bug-triage
@@ -73,7 +73,7 @@ the ones that are not reproducible on the current release.
know if you are able to? If I don't hear back in a few
weeks, I'll just close this bug as unreproducible."
[ ] Check that the priority is reasonable. Most bugs should be
- marked as normal, but crashers and security issues can be
+ marked as normal, but crashes and security issues can be
marked as serious.
3. Your changes will take some time to take effect. After a period of
minutes
to hours, you will get a mail telling you the control message has been
diff --git a/admin/notes/repo b/admin/notes/repo
index c2d7f993a0..97f02ab605 100644
--- a/admin/notes/repo
+++ b/admin/notes/repo
@@ -42,6 +42,24 @@ yet another fun excursion into the exciting world of version
control.
https://lists.gnu.org/r/emacs-devel/2010-04/msg00086.html
+* feature and scratch branches
+
+Besides the master branch, which is where development takes place, and
+the "emacs-NN" release branches, we also have branches whose names
+start with "scratch/" and "feature/". The "feature/" prefix is used
+for feature branches that are intended to live for some time, while
+"scratch/" is for one-off throw-away-after-use branches.
+
+We do not intend to "git merge" from scratch branches, so force-pushes
+are tolerated, as well as commits with poor style, incomplete commit
+messages, etc.
+
+We do expect to "git merge" from feature branches so: no force push,
+and no commits that don't have a proper commit message.
+
+Automatic tests are run for feature/* branches on EMBA.
+See: https://emba.gnu.org/emacs/emacs/-/pipelines
+
* Installing changes from gnulib
Some of the files in Emacs are copied from gnulib. To synchronize
@@ -110,6 +128,10 @@ again.
This is a semi-automated way to find the revision that introduced a bug.
Browse 'git help bisect' for technical instructions.
+It is recommended to start a bisection with the admin/git-bisect-start
+script. This script prunes the branches that are the result of
+merging external trees into the Emacs repository.
+
* Maintaining ChangeLog history
Older ChangeLog entries are kept in history files named ChangeLog.1,
diff --git a/admin/unidata/README b/admin/unidata/README
index 2da01402b7..2d421dfb6b 100644
--- a/admin/unidata/README
+++ b/admin/unidata/README
@@ -6,31 +6,31 @@ copyright.html.
The names, URLs, and dates for these files are as follows.
BidiBrackets.txt
-http://www.unicode.org/Public/UNIDATA/BidiBrackets.txt
+https://www.unicode.org/Public/UNIDATA/BidiBrackets.txt
2021-06-30
BidiMirroring.txt
-http://www.unicode.org/Public/UNIDATA/BidiMirroring.txt
+https://www.unicode.org/Public/UNIDATA/BidiMirroring.txt
2021-08-08
Blocks.txt
-http://www.unicode.org/Public/8.0.0/ucd/Blocks.txt
+https://www.unicode.org/Public/8.0.0/ucd/Blocks.txt
2021-01-22
IVD_Sequences.txt
-http://www.unicode.org/ivd/
+https://www.unicode.org/ivd/
2020-11-06
NormalizationTest.txt
-http://www.unicode.org/Public/UNIDATA/NormalizationTest.txt
+https://www.unicode.org/Public/UNIDATA/NormalizationTest.txt
2021-05-28
SpecialCasing.txt
-http://unicode.org/Public/UNIDATA/SpecialCasing.txt
+https://unicode.org/Public/UNIDATA/SpecialCasing.txt
2021-03-08
UnicodeData.txt
-http://www.unicode.org/Public/UNIDATA/UnicodeData.txt
+https://www.unicode.org/Public/UNIDATA/UnicodeData.txt
2021-07-06
emoji-data.txt
diff --git a/admin/unidata/blocks.awk b/admin/unidata/blocks.awk
index 1c571feff3..48a14ec3ca 100755
--- a/admin/unidata/blocks.awk
+++ b/admin/unidata/blocks.awk
@@ -23,7 +23,7 @@
### Commentary:
## This script takes as input Unicode's Blocks.txt
-## (http://www.unicode.org/Public/UNIDATA/Blocks.txt)
+## (https://www.unicode.org/Public/UNIDATA/Blocks.txt)
## and produces output for Emacs's lisp/international/charscript.el.
## It lumps together all the blocks belonging to the same language.
diff --git a/admin/unidata/copyright.html b/admin/unidata/copyright.html
index 0ae01c11ad..567c54e72a 100644
--- a/admin/unidata/copyright.html
+++ b/admin/unidata/copyright.html
@@ -13,7 +13,7 @@
<title>Unicode Terms of Use</title>
<link rel="stylesheet" type="text/css"
-href="http://www.unicode.org/webscripts/standard_styles.css";>
+href="https://www.unicode.org/webscripts/standard_styles.css";>
<style type="text/css">
pre {
@@ -32,8 +32,8 @@ pre {
<td colspan="2">
<table width="100%" border="0" cellpadding="0" cellspacing="0">
<tr>
- <td class="icon" style="width:38px; height:35px"><a
href="http://www.unicode.org/";><img border="0"
- src="http://www.unicode.org/webscripts/logo60s2.gif"; align="middle"
alt="[Unicode]" width="34" height="33"></a></td>
+ <td class="icon" style="width:38px; height:35px"><a
href="https://www.unicode.org/";><img border="0"
+ src="https://www.unicode.org/webscripts/logo60s2.gif"; align="middle"
alt="[Unicode]" width="34" height="33"></a></td>
<td class="icon" style="vertical-align:middle;"> <a class="bar"
href="https://www.unicode.org/copyright.html";><font size="3">Terms
of Use</font></a></td>
<td class="bar"><a href="https://www.unicode.org/main.html";
class="bar">Tech Site</a>
@@ -112,7 +112,7 @@ pre {
<p>For the general privacy policy governing access to this site,
see
the
- <a href="http://www.unicode.org/policies/privacy_policy.html";>
+ <a href="https://www.unicode.org/policies/privacy_policy.html";>
Unicode Privacy Policy</a>.</p>
<ol type="A">
@@ -158,7 +158,7 @@ http://site.icu-project.org/download/
specifications of rights and restrictions of use. For the book
editions (Unicode 5.0 and earlier), these are found on the back
of the
- <a
href="http://www.unicode.org/versions/Unicode5.0.0/Title.pdf";>title
page</a>.</li>
+ <a
href="https://www.unicode.org/versions/Unicode5.0.0/Title.pdf";>title
page</a>.</li>
<li>
The Unicode PDF <a
href="https://www.unicode.org/charts/";>online code charts</a> carry specific
restrictions. Those restrictions are incorporated as the
first page of each PDF code chart.</li>
@@ -224,7 +224,7 @@ http://site.icu-project.org/download/
<li><u><a name="5"></a>Trademarks & Logos</u>
<ol>
<li>The Unicode Word Mark and the Unicode Logo are trademarks
of Unicode, Inc. “The Unicode Consortium” and “Unicode, Inc.” are trade names
of Unicode, Inc. Use of the information and materials found on this website
indicates your acknowledgement of Unicode, Inc.’s exclusive worldwide rights in
the Unicode Word Mark, the Unicode Logo, and the Unicode trade names.</li>
-<li><a href="http://www.unicode.org/policies/logo_policy.html";>The Unicode
Consortium Name and Trademark Usage Policy</a> (“Trademark Policy”) are
incorporated herein by reference and you agree to abide by the provisions of
the Trademark Policy, which may be changed from time to time in the sole
discretion of Unicode, Inc.</li>
+<li><a href="https://www.unicode.org/policies/logo_policy.html";>The Unicode
Consortium Name and Trademark Usage Policy</a> (“Trademark Policy”) are
incorporated herein by reference and you agree to abide by the provisions of
the Trademark Policy, which may be changed from time to time in the sole
discretion of Unicode, Inc.</li>
<li>All third party trademarks referenced herein are the property of their
respective owners.</li>
</ol>
</li>
@@ -270,15 +270,15 @@ http://site.icu-project.org/download/
<center>
<table cellspacing="0" cellpadding="0" border="0" id="table2">
<tr>
- <td><a href="http://www.unicode.org/copyright.html";>
- <img src="http://www.unicode.org/img/hb_notice.gif";
+ <td><a href="https://www.unicode.org/copyright.html";>
+ <img src="https://www.unicode.org/img/hb_notice.gif";
border="0" alt="Access to Copyright and terms of use"
width="216" height="50"></a></td>
</tr>
</table>
<script language="Javascript" type="text/javascript"
- src="http://www.unicode.org/webscripts/lastModified.js";>
+ src="https://www.unicode.org/webscripts/lastModified.js";>
</script>
</center>
diff --git a/admin/update_autogen b/admin/update_autogen
index d1f49d9f25..55e11be95c 100755
--- a/admin/update_autogen
+++ b/admin/update_autogen
@@ -32,18 +32,7 @@
### Code:
-set -o nounset
-
-die () # write error to stderr and exit
-{
- [ $# -gt 0 ] && echo "$PN: $@" >&2
- exit 1
-}
-
-PN=${0##*/} # basename of script
-PD=${0%/*}
-
-[ "$PD" = "$0" ] && PD=. # if PATH includes PWD
+source "${0%/*}/emacs-shell-lib"
## This should be the admin directory.
cd $PD || exit
@@ -102,10 +91,7 @@ done
[ "$basegen" ] || die "internal error"
-tempfile=/tmp/$PN.$$
-
-trap 'rm -f $tempfile 2> /dev/null' EXIT
-
+tempfile="$(emacs_mktemp)"
while getopts ":hcfqA:CL" option ; do
case $option in
@@ -312,5 +298,3 @@ commit "loaddefs" $modified || die "commit error"
exit 0
-
-### update_autogen ends here
diff --git a/admin/upload-manuals b/admin/upload-manuals
index 50336ee64c..04f7c3acc7 100755
--- a/admin/upload-manuals
+++ b/admin/upload-manuals
@@ -36,15 +36,7 @@
### Code:
-set -o nounset
-
-die () # write error to stderr and exit
-{
- [ $# -gt 0 ] && echo "$PN: $@" >&2
- exit 1
-}
-
-PN=${0##*/} # basename of script
+source "${0%/*}/emacs-shell-lib"
usage ()
{
diff --git a/configure.ac b/configure.ac
index 20259186c1..187a43dc3e 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1171,6 +1171,13 @@ if test "$emacs_cv_clang" = yes; then
gl_WARN_ADD([-Wno-tautological-constant-out-of-range-compare])
fi
+# Suppress deprecation warnings from using sprintf variants,
+# starting with Xcode 14.1 on macOS 13.
+# These warnings are false alarms, as Emacs usage of sprintf is safe.
+if test $opsys = darwin; then
+ gl_WARN_ADD([-Wno-deprecated-declarations])
+fi
+
# Use a slightly smaller set of warning options for lib/.
nw=
nw="$nw -Wunused-macros"
@@ -6771,6 +6778,7 @@ if test -f "$srcdir/$opt_makefile.in"; then
dnl Again, it's best not to use a variable. Though you can add
dnl ", [], [opt_makefile='$opt_makefile']" and it should work.
AC_CONFIG_FILES([test/Makefile])
+ AC_CONFIG_FILES([test/manual/noverlay/Makefile])
fi
opt_makefile=test/infra/Makefile
if test -f "$srcdir/$opt_makefile.in"; then
diff --git a/doc/emacs/ChangeLog.1 b/doc/emacs/ChangeLog.1
index 048b7bd99a..6669e28e6b 100644
--- a/doc/emacs/ChangeLog.1
+++ b/doc/emacs/ChangeLog.1
@@ -1356,7 +1356,7 @@
* dired.texi (Dired Deletion, Marks vs Flags): Document Emacs 24.3
changes to the mark and unmark commands.
- (Comparison in Dired): Document chages to dired-diff. Remove M-=,
+ (Comparison in Dired): Document changes to dired-diff. Remove M-=,
which is no longer bound to dired-backup-diff.
2012-10-23 Bastien Guerry <bzg@gnu.org>
@@ -2711,7 +2711,7 @@
of list-faces-display here, from Standard Faces node.
Note special role of `default' background.
(Standard Faces): Note special role of `default' background.
- Note that region face may be taken fom GTK. Add xref to Text Display.
+ Note that region face may be taken from GTK. Add xref to Text Display.
(Text Scale): Rename from "Temporary Face Changes".
Callers changed. Don't bother documenting variable-pitch-mode.
(Font Lock): Copyedits. Remove font-lock-maximum-size.
diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi
index b79fa0a755..93ad4145cc 100644
--- a/doc/emacs/building.texi
+++ b/doc/emacs/building.texi
@@ -537,10 +537,13 @@ C/C++ files this is usually the C compiler. Flymake can
also use
build tools such as @code{make} for checking complicated projects.
To enable Flymake mode, type @kbd{M-x flymake-mode}. You can jump
-to the errors that it finds by using @kbd{M-x flymake-goto-next-error}
-and @kbd{M-x flymake-goto-prev-error}. To display any error messages
-associated with the current line, type @kbd{M-x
-flymake-display-err-menu-for-current-line}.
+to the errors that it finds by using @w{@kbd{M-x
+flymake-goto-next-error}} and @w{@kbd{M-x flymake-goto-prev-error}}.
+To display a detailed overview of the diagnostics for the current
+buffer, use the command @w{@kbd{M-x flymake-show-buffer-diagnostics}};
+to display a similar overview of diagnostics for the entire project
+(@pxref{Projects}), use @w{@kbd{M-x
+flymake-show-project-diagnostics}}.
For more details about using Flymake,
@ifnottex
diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi
index ff7ab83190..aaf41d2aef 100644
--- a/doc/emacs/custom.texi
+++ b/doc/emacs/custom.texi
@@ -667,6 +667,16 @@ type @kbd{M-x disable-theme}.
the @file{*Custom Themes*} buffer; or type @kbd{M-x describe-theme}
anywhere in Emacs and enter the theme name.
+@findex theme-choose-variant
+Some themes have variants (most often just two: light and dark). You
+can switch to another variant using @kbd{M-x theme-choose-variant}.
+If the currently active theme has only one other variant, it will be
+selected; if there are more variants, the command will prompt you
+which one to switch to.
+
+Note that @code{theme-choose-variant} only works if a single theme
+is active.
+
@node Creating Custom Themes
@subsection Creating Custom Themes
@cindex custom themes, creating
@@ -795,12 +805,12 @@ C-h v fill-column @key{RET}
displays something like this:
@example
-fill-column is a variable defined in ‘C source code’.
+fill-column is a variable defined in @quoteleft{}C source code@quoteright{}.
Its value is 70
Automatically becomes buffer-local when set.
This variable is safe as a file local variable if its value
- satisfies the predicate ‘integerp’.
+ satisfies the predicate @quoteleft{}integerp@quoteright{}.
Probably introduced at or before Emacs version 18.
Documentation:
@@ -1261,7 +1271,7 @@ mode: my-new
disable a minor mode in a local variables list, use the @code{eval}
keyword with a Lisp expression that runs the mode command
(@pxref{Minor Modes}). For example, the following local variables
-list enables ElDoc mode (@pxref{Lisp Doc}) by calling
+list enables ElDoc mode (@pxref{Programming Language Doc}) by calling
@code{eldoc-mode} with no argument (calling it with an argument of 1
would do the same), and disables Font Lock mode (@pxref{Font Lock}) by
calling @code{font-lock-mode} with an argument of @minus{}1.
@@ -1649,7 +1659,7 @@ events.
or lower case; @acronym{ASCII} or non-@acronym{ASCII}) are reserved
for users. Emacs itself will never bind those key sequences, and
Emacs extensions should avoid binding them. In other words, users can
-bind key sequences like @kbd{C-c a} or @kbd{C-c ç} and rely on these
+bind key sequences like @kbd{C-c a} or @kbd{C-c @,{c}} and rely on these
never being shadowed by other Emacs bindings.
@node Prefix Keymaps
@@ -2811,6 +2821,24 @@ strings incorrectly. You should then avoid adding Emacs
Lisp code
that modifies the coding system in other ways, such as calls to
@code{set-language-environment}.
+ An alternative to using non-@acronym{ASCII} characters directly is
+to use one of the character escape syntaxes described in
+@pxref{General Escape Syntax,,, elisp, The Emacs Lisp Reference
+Manual}, as they allow all Unicode codepoints to be specified using
+only @acronym{ASCII} characters.
+
+ To bind non-@acronym{ASCII} keys, you must use a vector (@pxref{Init
+Rebinding}). The string syntax cannot be used, since the
+non-@acronym{ASCII} characters will be interpreted as meta keys. For
+instance:
+
+@example
+(global-set-key [?@var{char}] 'some-function)
+@end example
+
+@noindent
+Type @kbd{C-q}, followed by the key you want to bind, to insert @var{char}.
+
@node Early Init File
@subsection The Early Init File
@cindex early init file
diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index a9b4ff783d..7a382c0566 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -807,7 +807,7 @@ should create non-existent directories in @var{new}.
The option @code{dired-create-destination-dirs-on-trailing-dirsep},
when set in addition to @code{dired-create-destination-dirs}, controls
-wether a trailing directory separator at the destination is treated
+whether a trailing directory separator at the destination is treated
specially. In that case, when renaming a directory @samp{old} to
@samp{new/} and no directory @samp{new} exists already, it will be
created and @samp{old} is moved into the newly created directory.
diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi
index b7c8825efa..cf4f041452 100644
--- a/doc/emacs/display.texi
+++ b/doc/emacs/display.texi
@@ -270,7 +270,7 @@ either at the top or bottom of the window depending on the
scroll
direction. By default, @code{scroll-conservatively} is@tie{}0, which
means to always center point in the window.
This said, in minibuffer windows, scrolling is always conservative by
-default because @code{scroll-minibuffer-conservatively} is non-nil,
+default because @code{scroll-minibuffer-conservatively} is non-@code{nil},
which takes precedence over @code{scroll-conservatively}.
@vindex scroll-step
diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index 727f5f93bf..5c81641bf6 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -718,7 +718,7 @@ Documentation Lookup
* Info Lookup:: Looking up library functions and commands in Info files.
* Man Page:: Looking up man pages of library functions and commands.
-* Lisp Doc:: Looking up Emacs Lisp functions, etc.
+* Programming Language Doc:: Looking up program functions, variables, etc.
C and Related Modes
diff --git a/doc/emacs/haiku.texi b/doc/emacs/haiku.texi
index ac631a39a6..33c81b6f17 100644
--- a/doc/emacs/haiku.texi
+++ b/doc/emacs/haiku.texi
@@ -108,7 +108,7 @@ You can create such a file with the @command{xmlbmessage}
tool.
@cindex crashes, Haiku
@cindex haiku debugger
@vindex haiku-debug-on-fatal-error
- If the variable @code{haiku-debug-on-fatal-error} is non-nil, Emacs
+ If the variable @code{haiku-debug-on-fatal-error} is non-@code{nil}, Emacs
will launch the system debugger when a fatal signal is received. It
defaults to @code{t}. If GDB cannot be used on your system, please
attach the report generated by the system debugger when reporting a
diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi
index bb8d51158a..bac2f7ff78 100644
--- a/doc/emacs/killing.texi
+++ b/doc/emacs/killing.texi
@@ -570,8 +570,8 @@ change the variable @code{select-enable-clipboard} to
@code{nil}.
instance, a web browser will usually let you choose ``Copy Image'' on
images, and this image will be put on the clipboard. On capable
platforms, Emacs can yank these objects with the @code{yank-media}
-command---but only in modes that have support for it (@w{@pxref{Yanking
-Media,,, elisp, The Emacs Lisp Reference Manual}}).
+command---but only in modes that have support for it (@pxref{Yanking
+Media,,, elisp, The Emacs Lisp Reference Manual}).
@cindex clipboard manager
@vindex x-select-enable-clipboard-manager
diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi
index d7c432d420..1457a8bc3a 100644
--- a/doc/emacs/macos.texi
+++ b/doc/emacs/macos.texi
@@ -159,7 +159,7 @@ dialogue on quitting.
@vindex ns-auto-hide-menu-bar
@item ns-auto-hide-menu-bar
This variable specifies whether the macOS menu bar is hidden when an
-Emacs frame is selected. If non-nil the menu bar is not shown unless
+Emacs frame is selected. If non-@code{nil} the menu bar is not shown unless
the mouse pointer is moved near to the top of the screen.
@vindex ns-use-native-fullscreen
@@ -178,14 +178,14 @@ These variables only apply to macOS 10.7 (Lion) and above.
@item ns-use-mwheel-acceleration
This variable controls whether Emacs ignores the system mousewheel
acceleration. When nil each `click' of the mousewheel will correspond
-exactly with one mousewheel event. When non-nil, the default, each
+exactly with one mousewheel event. When non-@code{nil}, the default, each
`click' may correspond with more than one mousewheel event, depending
on the user's input.
@vindex ns-use-mwheel-momentum
@item ns-use-mwheel-momentum
This variable controls whether Emacs ignores the system `momentum'
-when scrolling using a trackpad. When non-nil, the default, scrolling
+when scrolling using a trackpad. When non-@code{nil}, the default, scrolling
rapidly may result in the buffer continuing to scroll for a short
while after the user has lifted their fingers off the trackpad.
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index 6857e67def..44e9e1896f 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -4,6 +4,8 @@
@c See file emacs.texi for copying conditions.
@node Maintaining
@chapter Maintaining Large Programs
+@cindex maintaining large programs
+@cindex large programming projects, maintaining
This chapter describes Emacs features for maintaining medium- to
large-size programs and packages. These features include:
@@ -1830,6 +1832,8 @@ directory. @xref{Top,Eshell,Eshell, eshell, Eshell: The
Emacs Shell}.
@item C-x p b
Switch to another buffer belonging to the current project
(@code{project-switch-to-buffer}).
+@item C-x p C-b
+List the project buffers (@code{project-list-buffers}).
@item C-x p k
Kill all live buffers that belong to the current project
(@code{project-kill-buffers}).
@@ -1845,6 +1849,11 @@ switch between buffers that belong to the current
project by prompting
for a buffer to switch and considering only the current project's
buffers as candidates for completion.
+@findex project-list-buffers
+ Like the command @code{list-buffers} (@pxref{List Buffers}), the
+command @kbd{C-x p C-b} (@code{project-list-buffers}) displays a list
+of existing buffers, but only belonging to the current project.
+
@findex project-kill-buffers
@vindex project-kill-buffer-conditions
@vindex project-kill-buffers-display-buffer-list
@@ -2094,6 +2103,13 @@ definitions of symbols. (One disadvantage of this kind
of backend is
that it only knows about subunits that were loaded into the
interpreter.)
+@item
+If Eglot is activated for the current buffer's project
+(@pxref{Projects}) and the current buffer's major mode, Eglot consults
+an external language server program and provides the data supplied by
+the server regarding the definitions of the identifiers in the
+project. @xref{Eglot Features,,, eglot, Eglot: The Emacs LSP Client}.
+
@item
An external program can extract references by scanning the relevant
files, and build a database of these references. A backend can then
@@ -2302,7 +2318,9 @@ Display the reference on the current line in the other
window
@item r @var{pattern} @key{RET} @var{replacement} @key{RET}
Perform interactive query-replace on references that match
@var{pattern} (@code{xref-query-replace-in-results}), replacing
-the match with @var{replacement}. @xref{Identifier Search}.
+the match with @var{replacement}. This command can only be used in
+@file{*xref*} buffers that show all the matches for an identifier in
+all the relevant files. @xref{Identifier Search}.
@item g
@findex xref-revert-buffer
@@ -2336,7 +2354,8 @@ them.
@item M-?
Find all the references for the identifier at point.
-@item M-x xref-query-replace-in-results @key{RET} @var{replacement} @key{RET}
+@item r
+@itemx M-x xref-query-replace-in-results @key{RET} @var{replacement} @key{RET}
@itemx C-u M-x xref-query-replace-in-results @key{RET} @var{regexp} @key{RET}
@var{replacement} @key{RET}
Interactively replace @var{regexp} with @var{replacement} in the names
of all the identifiers shown in the @file{*xref*} buffer.
@@ -2382,16 +2401,18 @@ shown. The default value is @code{nil}, which just
shows the results
in the @file{*xref*} buffer, but doesn't select any of them.
@findex xref-query-replace-in-results
- @kbd{M-x xref-query-replace-in-results} reads a @var{replacement}
+ @kbd{r} (@code{xref-query-replace-in-results}) reads a @var{replacement}
string, just like ordinary @kbd{M-x query-replace-regexp}. It then
renames the identifiers shown in the @file{*xref*} buffer in all the
places in all the files where these identifiers are referenced, such
that their new name is @var{replacement}. This is useful when you
rename your identifiers as part of refactoring. This command should
-be invoked in the @file{*xref*} buffer generated by @kbd{M-?}. With a
-prefix argument, the command also prompts for a regexp to match
-identifier names, and renames that regexp in the names of the matching
-identifiers with @var{replacement}.
+be invoked in the @file{*xref*} buffer generated by @kbd{M-?}. By
+default, the command replaces the entire name of each identifier with
+@var{replacement}, but if invoked with a prefix argument, the command
+prompts for a regexp to match identifier names, and replaces only the
+matches of that regexp in the names of the identifiers with
+@var{replacement}.
@findex xref-find-references-and-replace
@kbd{M-x xref-find-references-and-replace} works similarly to
@@ -3284,7 +3305,7 @@ according to @code{bug-reference-setup-from-mail-alist},
and @code{bug-reference-maybe-setup-from-irc} which does the setup
according to @code{bug-reference-setup-from-irc-alist}.
@end itemize
-A setup function should return non-nil if it could setup bug-reference
+A setup function should return non-@code{nil} if it could setup bug-reference
mode which is the case if the last thing the function does is calling
one of the helper functions above.
diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi
index db96093a17..5472a288d1 100644
--- a/doc/emacs/mark.texi
+++ b/doc/emacs/mark.texi
@@ -50,10 +50,10 @@ Ring}. Additionally, some commands will have an effect
even on an
inactive region (for example @dfn{upcase-region}). You can also
reactivate the region with commands like @kbd{C-x C-x}.
- The above default behavior is known as Transient Mark mode.
-Disabling Transient Mark mode switches Emacs to an alternative
-behavior, in which the region is usually not highlighted.
-@xref{Disabled Transient Mark}.
+ The above behavior, which is the default in interactive sessions, is
+known as Transient Mark mode. Disabling Transient Mark mode switches
+Emacs to an alternative behavior, in which the region is usually not
+highlighted. @xref{Disabled Transient Mark}.
@vindex highlight-nonselected-windows
Setting the mark in one buffer has no effect on the marks in other
@@ -455,10 +455,11 @@ motion keys will extend the region set by shift-selection.
The default behavior of the mark and region, in which setting the
mark activates it and highlights the region, is called Transient Mark
-mode. This is a minor mode that is enabled by default. It can be
-toggled with @kbd{M-x transient-mark-mode}, or with the
-@samp{Highlight Active Region} menu item in the @samp{Options} menu.
-Turning it off switches Emacs to an alternative mode of operation:
+mode. This is a minor mode that is enabled by default in interactive
+sessions. It can be toggled with @kbd{M-x transient-mark-mode}, or
+with the @samp{Highlight Active Region} menu item in the
+@samp{Options} menu. Turning it off switches Emacs to an alternative
+mode of operation:
@itemize @bullet
@item
diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi
index 1514e316f8..29c0bed19c 100644
--- a/doc/emacs/misc.texi
+++ b/doc/emacs/misc.texi
@@ -1540,7 +1540,7 @@ color is supported. Therefore, Emacs provides an option
@code{comint-terminfo-terminal} to let you choose a terminal with more
advanced features, as defined in your system's terminfo database.
Emacs will use this option as the value for @env{TERM} so long as
-@code{system-uses-terminfo} is non-nil.
+@code{system-uses-terminfo} is non-@code{nil}.
Both @code{comint-terminfo-terminal} and @code{system-uses-terminfo}
can be declared as connection-local variables to adjust these options
diff --git a/doc/emacs/modes.texi b/doc/emacs/modes.texi
index 56b779f8de..1a32f61947 100644
--- a/doc/emacs/modes.texi
+++ b/doc/emacs/modes.texi
@@ -127,7 +127,7 @@ see which mode is actually being entered.
Modes}). For example, you can put the following lines in your init
file to enable Flyspell minor mode in all text-based major modes
(@pxref{Spelling}), and ElDoc minor mode in Emacs Lisp mode
-(@pxref{Lisp Doc}):
+(@pxref{Programming Language Doc}):
@example
(add-hook 'text-mode-hook 'flyspell-mode)
diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi
index 420da09097..cd4c113ae5 100644
--- a/doc/emacs/package.texi
+++ b/doc/emacs/package.texi
@@ -49,6 +49,7 @@ Manual}.
* Package Statuses:: Which statuses a package can have.
* Package Installation:: Options for package installation.
* Package Files:: Where packages are installed.
+* Fetching Package Sources:: Managing packages directly from source.
@end menu
@node Package Menu
@@ -530,3 +531,73 @@ are laid out in the same way as in @code{package-user-dir}.
corresponding package subdirectory. This only works for packages
installed in @code{package-user-dir}; if told to act on a package in a
system-wide package directory, the deletion command signals an error.
+
+@node Fetching Package Sources
+@section Fetching Package Sources
+@cindex package development source
+@cindex upstream source, for packages
+@cindex git source of package @c "git" is not technically correct
+
+ By default @code{package-install} downloads a Tarball from a package
+archive and installs its files. This might be inadequate if you wish
+to hack on the package sources and share your changes with others. In
+that case, you may prefer to directly fetch and work on the upstream
+source. This often makes it easier to develop patches and report
+bugs.
+
+@findex package-vc-install
+@findex package-vc-checkout
+ One way to do this is to use @code{package-vc-install}, to fetch the
+source code for a package directly from source. The command will also
+automatically ensure that all files are byte-compiled and auto-loaded,
+just like with a regular package. Packages installed this way behave
+just like any other package. You can update them using
+@code{package-update} or @code{package-update-all} and delete them
+again using @code{package-delete}. They are even displayed in the
+regular package listing. If you just wish to clone the source of a
+package, without adding it to the package list, use
+@code{package-vc-checkout}.
+
+@vindex package-vc-selected-packages
+@findex package-vc-install-selected-packages
+ An alternative way to use @code{package-vc-install} is via the
+@code{package-vc-selected-packages} user option. This is an alist of
+packages to install, where each key is a package name and the value is
+@code{nil}, indicating that any revision is to install, a string,
+indicating a specific revision or a package specification plist. The
+side effect of setting the user option is to install the package, but
+the process can also be manually triggered using the function
+@code{package-vc-install-selected-packages}. Here is an example of
+how the user option:
+
+@example
+@group
+(setopt package-vc-selected-packages
+ '((modus-themes . "0f39eb3fd9") ;specific revision
+ (auctex . nil) ;any revision
+ (foo ;a package specification
+ :url "https://git.sv.gnu.org/r/foo-mode.git";
+ :branch "trunk")))
+@end group
+@end example
+
+@findex package-report-bug
+@findex package-vc-prepare-patch
+ With the source checkout, you might want to reproduce a bug against
+the current development head or implement a new feature to scratch an
+itch. If the package metadata indicates how to contact the
+maintainer, you can use the command @code{package-report-bug} to
+report a bug via Email. This report will include all the user options
+that you have customized. If you have made a change you wish to share
+with the maintainers, first commit your changes then use the command
+@code{package-vc-prepare-patch} to share it. @xref{Preparing Patches}.
+
+@findex package-vc-install-from-checkout
+@findex package-vc-rebuild
+ If you maintain your own packages you might want to use a local
+checkout instead of cloning a remote repository. You can do this by
+using @code{package-vc-install-from-checkout}, which creates a symbolic link
+from the package directory (@pxref{Package Files}) to your checkout
+and initializes the code. Note that you might have to use
+@code{package-vc-refresh} to repeat the initialization and update the
+autoloads.
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 03f565808d..6abf29c009 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -287,6 +287,13 @@ they occur in the buffer; if you want alphabetic sorting,
use the
symbol @code{imenu--sort-by-name} as the value. You can also
define your own comparison function by writing Lisp code.
+ If Eglot is activated for the current buffer's project
+(@pxref{Projects}) and the current buffer's major mode, Eglot provides
+its own facility for producing the buffer's index based on the
+analysis of the program source by the language-server which manages
+the current buffer. @xref{Eglot Features,,, eglot, Eglot: The Emacs
+LSP Client}.
+
Imenu provides the information to guide Which Function mode
@ifnottex
(@pxref{Which Function}).
@@ -985,7 +992,7 @@ Set comment column (@code{comment-set-column}).
@item @kbd{C-M-j}
@itemx @kbd{M-j}
Like @kbd{@key{RET}} followed by inserting and aligning a comment
-(@code{comment-indent-new-line}). @xref{Multi-Line Comments}.
+(@code{default-indent-new-line}). @xref{Multi-Line Comments}.
@item @kbd{M-x comment-region}
@itemx @kbd{C-c C-c} (in C-like modes)
Add comment delimiters to all the lines in the region.
@@ -1080,10 +1087,10 @@ the brace rather than at @code{comment-column}. For
full details see
@kindex C-M-j
@kindex M-j
@cindex blank lines in programs
-@findex comment-indent-new-line
+@findex default-indent-new-line
@vindex comment-multi-line
If you are typing a comment and wish to continue it to another line,
-type @kbd{M-j} or @kbd{C-M-j} (@code{comment-indent-new-line}). This
+type @kbd{M-j} or @kbd{C-M-j} (@code{default-indent-new-line}). This
breaks the current line, and inserts the necessary comment delimiters
and indentation to continue the comment.
@@ -1190,7 +1197,7 @@ use in your program.
@menu
* Info Lookup:: Looking up library functions and commands in Info
files.
* Man Page:: Looking up man pages of library functions and commands.
-* Lisp Doc:: Looking up Emacs Lisp functions, etc.
+* Programming Language Doc:: Looking up program functions, variables, etc.
@end menu
@node Info Lookup
@@ -1291,8 +1298,10 @@ WoMan Manual}.
the WoMan Info manual, which is distributed with Emacs.
@end ifnotinfo
-@node Lisp Doc
-@subsection Emacs Lisp Documentation Lookup
+@node Programming Language Doc
+@subsection Programming Language Documentation Lookup
+@cindex documentation for program symbols
+@cindex program functions and variables, documentation lookup
When editing Emacs Lisp code, you can use the commands @kbd{C-h f}
(@code{describe-function}) and @kbd{C-h v} (@code{describe-variable})
@@ -1300,43 +1309,120 @@ to view the built-in documentation for the Lisp
functions and
variables that you want to use. @xref{Name Help}.
@cindex ElDoc mode
+@cindex at-point documentation for program symbols
@findex eldoc-mode
@findex global-eldoc-mode
- ElDoc is a buffer-local minor mode that helps with looking up Lisp
-documentation. When it is enabled, the echo area displays some useful
-information whenever there is a Lisp function or variable at point;
-for a function, it shows the argument list, and for a variable it
-shows the first line of the variable's documentation string. To
-toggle ElDoc mode, type @kbd{M-x eldoc-mode}. There's also a Global
-ElDoc mode, which is turned on by default, and affects buffers whose
-major mode sets the variables described below. Use @w{@kbd{M-x
-global-eldoc-mode}} to turn it off globally.
-
-@vindex eldoc-documentation-strategy
-@vindex eldoc-documentation-functions
- These variables can be used to configure ElDoc mode:
+ ElDoc@footnote{
+The name ``ElDoc'' is a historical accident: this mode started by
+supporting Emacs Lisp buffers.
+} is a buffer-local minor mode that helps with looking up
+documentation of symbols (functions, methods, classes, variables,
+etc.) in your program. When this mode is enabled, the echo area
+displays useful information whenever there is a documented symbol at
+point. For example, in buffers under the Emacs Lisp mode, it shows
+the argument list of a function at point, and for a Lisp variable it
+shows the first line of the variable's documentation string.
+
+To toggle ElDoc mode, type @kbd{M-x eldoc-mode}. There's also a
+Global ElDoc mode, which is turned on by default, and turns on the
+ElDoc mode in buffers whose major mode sets the variables described
+below. Use @w{@kbd{M-x global-eldoc-mode}} to turn it off globally.
+
+Various major modes configure the Global ElDoc mode to use their
+documentation functions. Examples include Emacs Lisp mode, Python
+mode, and Cfengine mode. In addition, Emacs features that provide
+support for several major modes configure ElDoc to use their
+facilities for retrieving the documentation. Examples include Eglot
+(@pxref{Eglot Features,,, eglot, Eglot: The Emacs LSP Client}), which
+provides documentation based on information from language servers;
+Semantic's Idle Summary mode (@pxref{Idle Summary Mode,,, semantic,
+Semantic Manual}); and Flymake, which uses ElDoc to show diagnostics
+at point (@pxref{Finding diagnostics,,, flymake, GNU Flymake manual}).
+
+The ElDoc mode works by scheduling the display of the available
+documentation for the symbol at point after Emacs has been idle for
+some short time. This avoids annoying flickering of documentation
+messages in the echo area or the mode line when you type quickly and
+without delay.
+
+@findex eldoc-print-current-symbol-info
+You can also trigger the display of documentation for a symbol at
+point by using the command @kbd{M-x eldoc-print-current-symbol-info}.
+
+ The following variables can be used to configure ElDoc mode:
+
+@vtable @code
+@item eldoc-idle-delay
+The value of this user option controls the amount of idle time before
+the at-point documentation is displayed. It should be set to the
+number of seconds to wait; the value of zero means to display without
+any delay. The default is 0.5 sec.
+
+@item eldoc-print-after-edit
+If this user option is non-@code{nil}, ElDoc will show documentation
+only after some editing command, like inserting or deleting some
+text. This comes in handy if you want Emacs to display documentation
+only about symbols that you type, but not about symbols that are
+already in the buffer (so just reading the source code will not show
+documentation). The default value is @code{nil}. If you change the
+value, you need to toggle @code{eldoc-mode} off and on again.
+
+@item eldoc-echo-area-use-multiline-p
+This user option controls whether and how to truncate documentation
+text if it is longer than the echo-area can display as a single screen
+line. If the value is a positive number, it specifies the number of
+screen lines that ElDoc is allowed to display in the echo area without
+truncating the documentation. A positive integer specifies the
+absolute maximum number of screen lines to use; a floating-point
+number specifies the number of screen lines as a fraction of the
+frame's height. The value of @code{t} means never truncate the
+documentation (the echo-area will be resized up to the height allowed
+by @code{max-mini-window-height}, @pxref{Minibuffer Edit}), whereas
+the value of @code{nil} means truncate if the documentation is longer
+than a single screen line. Finally, the special value
+@code{truncate-sym-name-if-fit} (the default) means to truncate the
+part of the documentation that represents a symbol's name if doing
+that will allow the documentation to fit on a single screen line.
+
+@item eldoc-echo-area-display-truncation-message
+If non-@code{nil} (the default), and documentation shown in the echo
+area is truncated because it's too long, follow the documentation by
+instructions about how to view the complete documentation text. If
+@code{nil}, just indicate with @samp{@dots{}} that the documentation
+was truncated.
+
+@findex eldoc-doc-buffer
+@item eldoc-echo-area-prefer-doc-buffer
+If the value of this user option is @code{t}, ElDoc will not show the
+documentation in the echo area if the ElDoc buffer with the
+documentation is already displayed in some window. (You can use the
+command @kbd{M-x eldoc-doc-buffer} any time to show the ElDoc buffer.)
+If the value of this option is the symbol @code{maybe}, the
+documentation will not be displayed in the echo area if the ElDoc
+buffer is shown in some window, and the documentation text has to be
+truncated if displayed in the echo area. Finally, the value of
+@code{nil} (the default) means always show the documentation in the
+echo area.
-@table @code
@item eldoc-documentation-strategy
-This variable holds the function which is used to retrieve
-documentation for the item at point from the functions in the hook
-@code{eldoc-documentation-functions}. By default,
-@code{eldoc-documentation-strategy} returns the first documentation
-string produced by the @code{eldoc-documentation-functions} hook, but
-it may be customized to compose those functions' results in other
-ways.
+This customizable variable's value is the function which is used to
+retrieve and display documentation for the symbol at point. The
+documentation is produced by the functions in the hook
+@code{eldoc-documentation-functions}. The default value of
+@code{eldoc-documentation-strategy} specifies that ElDoc should
+display the first documentation text produced by functions in the
+@code{eldoc-documentation-functions} hook, but you can customize
+@code{eldoc-documentation-strategy} to work in other ways, such as
+displaying all of the documentation texts concatenated together.
@item eldoc-documentation-functions
-This abnormal hook holds documentation functions. It acts as a
-collection of backends for ElDoc. This is what modes should use to
-register their documentation functions with ElDoc.
-
-@vindex eldoc-display-truncation-message
-@item eldoc-display-truncation-message
-If non-@code{nil} (the default), display a verbose message about how
-to view a complete documentation (if it has been truncated in the echo
-area). If @code{nil}, just mark truncated messages with @samp{...}.
-@end table
+This abnormal hook's value is a list of functions that can produce
+documentation for the symbol at point as appropriate for the current
+buffer's major-mode. These functions act as a collection of backends
+for ElDoc. Major mode register their documentation lookup functions
+with ElDoc by adding their functions to the buffer-local value of this
+variable.
+@end vtable
@node Hideshow
@section Hideshow minor mode
@@ -1365,7 +1451,7 @@ count as blocks.
@findex hs-show-region
@findex hs-hide-level
@findex hs-toggle-hiding
-@findex hs-mouse-toggle-hiding
+@findex hs-toggle-hiding
@kindex C-c @@ C-h
@kindex C-c @@ C-s
@kindex C-c @@ C-c
@@ -1382,9 +1468,8 @@ Hide the current block (@code{hs-hide-block}).
Show the current block (@code{hs-show-block}).
@item C-c @@ C-c
@itemx C-c @@ C-e
+@itemx S-mouse-2
Either hide or show the current block (@code{hs-toggle-hiding}).
-@item S-mouse-2
-Toggle hiding for the block you click on (@code{hs-mouse-toggle-hiding}).
@item C-c @@ C-M-h
@itemx C-c @@ C-t
Hide all top-level blocks (@code{hs-hide-all}).
@@ -1422,27 +1507,45 @@ nor comments). The default value is @code{code}.
Completion is normally done in the minibuffer (@pxref{Completion}),
but you can also complete symbol names in ordinary Emacs buffers.
+@cindex tags-based completion
@kindex M-TAB
@kindex C-M-i
- In programming language modes, type @kbd{C-M-i} or @kbd{M-@key{TAB}}
-to complete the partial symbol before point. On graphical displays,
-the @kbd{M-@key{TAB}} key is usually reserved by the window manager
-for switching graphical windows, so you should type @kbd{C-M-i} or
-@kbd{@key{ESC} @key{TAB}} instead.
-
-@cindex tags-based completion
@findex completion-at-point@r{, in programming language modes}
@cindex Lisp symbol completion
@cindex completion (Lisp symbols)
In most programming language modes, @kbd{C-M-i} (or
-@kbd{M-@key{TAB}}) invokes the command @code{completion-at-point},
-which generates its completion list in a flexible way. If Semantic
-mode is enabled, it tries to use the Semantic parser data for
-completion (@pxref{Semantic}). If Semantic mode is not enabled or
-fails at performing completion, it tries to complete using the
-selected tags table (@pxref{Tags Tables}). If in Emacs Lisp mode, it
-performs completion using the function, variable, or property names
-defined in the current Emacs session.
+@kbd{M-@key{TAB}}@footnote{
+On graphical displays, the @kbd{M-@key{TAB}} key is usually reserved
+by the window manager for switching graphical windows, so you should
+type @kbd{C-M-i} or @kbd{@key{ESC} @key{TAB}} instead.
+}) invokes the command @code{completion-at-point}, which generates the
+list of possible completions for the symbol at point. This command
+uses the available support facilities to come up with the completion
+candidates:
+
+@itemize @bullet
+@item
+If Eglot is activated for the current buffer's project
+(@pxref{Projects}) and the current buffer's major mode, the command
+tries to use the corresponding language server for producing the list
+of completion candidates. @xref{Eglot Features,,, eglot, Eglot: The
+Emacs LSP Client}.
+
+@item
+If Semantic mode is enabled (@pxref{Semantic}), the command tries to
+use the Semantic parser data for completion.
+
+@item
+If Semantic mode is not enabled or fails at performing completion, the
+command tries to complete using the selected tags table (@pxref{Tags
+Tables}); you need to visit the tags table with @w{@kbd{M-x
+visit-tags-table}} for that to work.
+
+@item
+In Emacs Lisp mode, the command performs completion using the
+function, variable, or property names defined in the current Emacs
+session.
+@end itemize
In all other respects, in-buffer symbol completion behaves like
minibuffer completion. For instance, if Emacs cannot complete to
diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi
index e38bde036a..7414cdb079 100644
--- a/doc/emacs/rmail.texi
+++ b/doc/emacs/rmail.texi
@@ -1409,6 +1409,14 @@ might use rot13 to hide important plot points.
rot13-other-window}. This displays the current buffer in another window
which applies the code when displaying the text.
+@findex rot13-region
+ If you are only interested in a region, the command @kbd{M-x
+rot13-region} might be preferable. This will encrypt/decrypt the
+active region in-place. If the buffer is read-only, it will attempt
+to display the plain text in the echo area. If the text is too long
+for the echo area, the command will pop up a temporary buffer with the
+encrypted/decrypted text.
+
@node Movemail
@section @command{movemail} program
@cindex @command{movemail} program
diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi
index 582e764c55..63541d78a5 100644
--- a/doc/emacs/search.texi
+++ b/doc/emacs/search.texi
@@ -1348,18 +1348,19 @@ tailor them to your needs.
@kindex SPC @r{(Incremental search)}
@findex isearch-toggle-lax-whitespace
@vindex search-whitespace-regexp
- By default, search commands perform @dfn{lax space matching}:
-each space, or sequence of spaces, matches any sequence of one or more
-whitespace characters in the text. (Incremental regexp search has a
-separate default; see @ref{Regexp Search}.) Hence, @w{@samp{foo bar}}
-matches @w{@samp{foo bar}}, @w{@samp{foo@ @ bar}},
-@w{@samp{foo@ @ @ bar}}, and so on (but not @samp{foobar}). More
-precisely, Emacs matches each sequence of space characters in the
-search string to a regular expression specified by the variable
-@code{search-whitespace-regexp}. For example, to make spaces match
-sequences of newlines as well as spaces, set it to the regular expression
-@samp{[[:space:]\n]+}. The default value of this variable considers
-any sequence of spaces and tab characters as whitespace.
+ By default, search commands perform @dfn{lax space matching}: each
+space, or sequence of spaces, matches any sequence of one or more
+whitespace characters in the text. More precisely, Emacs matches each
+sequence of space characters in the search string to a regular
+expression specified by the user option
+@code{search-whitespace-regexp}. The default value of this option
+considers any sequence of spaces and tab characters as whitespace.
+Hence, @w{@samp{foo bar}} matches @w{@samp{foo bar}}, @w{@samp{foo@ @
+bar}}, @w{@samp{foo@ @ @ bar}}, and so on (but not @samp{foobar}). If
+you want to make spaces match sequences of newlines as well as spaces
+and tabs, customize the option to make its value be the regular
+expression @samp{[ \t\n]+}. (The default behavior of the
+incremental regexp search is different; see @ref{Regexp Search}.)
If you want whitespace characters to match exactly, you can turn lax
space matching off by typing @kbd{M-s @key{SPC}}
diff --git a/doc/emacs/text.texi b/doc/emacs/text.texi
index b103e22e39..27abe5caaa 100644
--- a/doc/emacs/text.texi
+++ b/doc/emacs/text.texi
@@ -460,7 +460,7 @@ variables.
@vindex electric-quote-replace-double
You can also set the option @code{electric-quote-replace-double} to
-a non-@code{nil} value. Then, typing @kbd{"} insert an appropriate
+a non-@code{nil} value. Then, typing @kbd{"} inserts an appropriate
curved double quote depending on context: @t{“} at the beginning of
the buffer or after a line break, whitespace, opening parenthesis, or
quote character, and @t{”} otherwise.
@@ -998,15 +998,14 @@ major mode's special commands. (The variable
@vindex outline-minor-mode-use-buttons
If @code{outline-minor-mode-use-buttons} is non-@code{nil}, Outline
-minor mode will use buttons (at the start of the header lines) in
-addition to ellipsis to show that a section is hidden. Using
-@kbd{RET} (or clicking on the button with a mouse) will toggle
-displaying the section.
-
-@vindex outline-minor-mode-use-margins
- If @code{outline-minor-mode-use-margins} is non-@code{nil}, Outline
-minor mode will use the window margins in addition to ellipsis to show
-that a section is hidden.
+minor mode will use buttons at the beginning of the heading lines, in
+addition to ellipsis, to show that a section is hidden. Clicking the
+mouse on the button toggles display of the section. If the value of
+this variable is @code{insert}, the buttons are inserted directly into
+the buffer text, so @key{RET} on the button will also toggle display
+of the section, like a mouse click does. If the value is
+@code{in-margins}, Outline minor mode will use the window margins to
+indicate that a section is hidden.
@vindex outline-minor-mode-cycle
If the @code{outline-minor-mode-cycle} user option is
diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi
index 05d2144380..23d5f50432 100644
--- a/doc/emacs/vc1-xtra.texi
+++ b/doc/emacs/vc1-xtra.texi
@@ -16,6 +16,7 @@
* Revision Tags:: Symbolic names for revisions.
* Version Headers:: Inserting version control headers into working files.
* Editing VC Commands:: Editing the VC shell commands that Emacs will run.
+* Preparing Patches:: Preparing and Composing patches from within VC
@end menu
@node Change Logs and VC
@@ -282,6 +283,37 @@ type @w{@kbd{C-x v ! C-x v b l}} and then append the names
of
additional branches to the end of the @samp{git log} command that VC
is about to run.
+@node Preparing Patches
+@subsubsection Preparing Patches
+
+@findex vc-prepare-patch
+When collaborating on projects it is common to send patches via email,
+to share changes. If you wish to do this using VC, you can use the
+@code{vc-prepare-patch} command. This will prompt you for the
+revisions you wish to share, and which destination email address(es)
+to use. The revisions are separated using commas (or whatever was
+configured by @var{crm-separator}). The command will then prepare
+those revisions using your @abbr{MUA, Mail User Agent} for you to
+review and send.
+
+When invoked interactively in a Log View buffer with marked revisions,
+these revisions will be used.
+
+@vindex vc-prepare-patches-separately
+Depending on the value of the user option
+@code{vc-prepare-patches-separately}, @code{vc-prepare-patch} will
+generate one or more messages. The default value @code{t} means
+prepare and display a message for each revision, one after another. A
+value of @code{nil} means to generate a single message with all
+patches attached in the body.
+
+@vindex vc-default-patch-addressee
+If you expect to contribute patches on a regular basis, you can set
+the user option @code{vc-default-patch-addressee} to the address(es)
+you wish to use. This will be used as the default value when invoking
+@code{vc-prepare-patch}. Project maintainers may consider setting
+this as a directory local variable (@pxref{Directory Variables}).
+
@node Customizing VC
@subsection Customizing VC
diff --git a/doc/lispref/backups.texi b/doc/lispref/backups.texi
index d99487368b..f0b154e495 100644
--- a/doc/lispref/backups.texi
+++ b/doc/lispref/backups.texi
@@ -474,7 +474,7 @@ Each transform is a list of the form @w{@code{(@var{regexp}
@var{replacement} [@var{uniquify}])}}. @var{regexp} is a regular
expression to match against the file name; if it matches,
@code{replace-match} is used to replace the matching part with
-@var{replacement}. If the optional element @var{uniquify} is non-nil,
+@var{replacement}. If the optional element @var{uniquify} is non-@code{nil},
the auto-save file name is constructed by concatenating the directory
part of the transformed file name with the buffer's file name in which
all directory separators were changed to @samp{!} to prevent clashes.
diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi
index 6a1d125701..c40e088293 100644
--- a/doc/lispref/buffers.texi
+++ b/doc/lispref/buffers.texi
@@ -427,19 +427,19 @@ It is a permanent local, unaffected by
@end defvar
@defvar buffer-file-number
-This buffer-local variable holds the file number and directory device
-number of the file visited in the current buffer, or @code{nil} if no
+This buffer-local variable holds the inode number and device
+identifier of the file visited in the current buffer, or @code{nil} if no
file or a nonexistent file is visited. It is a permanent local,
unaffected by @code{kill-all-local-variables}.
-The value is normally a list of the form @code{(@var{filenum}
-@var{devnum})}. This pair of numbers uniquely identifies the file among
+The value is normally a list of the form @code{(@var{inodenum}
+@var{device})}. This tuple uniquely identifies the file among
all files accessible on the system. See the function
@code{file-attributes}, in @ref{File Attributes}, for more information
about them.
If @code{buffer-file-name} is the name of a symbolic link, then both
-numbers refer to the recursive target.
+@var{inodenum} and @var{device} refer to the recursive target of the link.
@end defvar
@defun get-file-buffer filename
diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi
index ede1c4d762..377b433cae 100644
--- a/doc/lispref/commands.texi
+++ b/doc/lispref/commands.texi
@@ -2726,7 +2726,7 @@ coordinates @var{x} and @var{y} in a specified frame or
window,
@var{frame-or-window}, which defaults to the selected window.
The coordinates @var{x} and @var{y} are relative to the
text area of the selected window.
-If @var{whole} is @code{non-nil}, the @var{x} coordinate is relative
+If @var{whole} is non-@code{nil}, the @var{x} coordinate is relative
to the entire window area including scroll bars, margins and fringes.
@end defun
diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi
index 7ccee08e53..d1d281d709 100644
--- a/doc/lispref/compile.texi
+++ b/doc/lispref/compile.texi
@@ -843,6 +843,14 @@ native compilation of that file. In addition, a similar
variable
file. If both @code{no-byte-compile} and @code{no-native-compile} are
specified, the former takes precedence.
+@cindex native compilation, prevent writing @file{*.eln} files
+ Sometimes there could be a need to prevent the native compilation
+from writing its results, the @file{*.eln} files, into a subdirectory
+of @code{user-emacs-directory} (@pxref{Init File}). You can do that
+by either changing the value of @code{native-comp-eln-load-path}
+(@pxref{Native-Compilation Variables}) or by temporarily pointing the
+@env{HOME} environment variable to a non-existing directory.
+
@menu
* Native-Compilation Functions:: Functions to natively-compile Lisp.
* Native-Compilation Variables:: Variables controlling native compilation.
@@ -985,7 +993,7 @@ too late.
While setting this variable disables automatic compilation of Lisp
files, the compiler may still be invoked to install @dfn{trampolines}
if any built-in functions are redefined. However, these trampolines
-will not get written to disk.
+will not get written to your cache directory.
You can also use the @samp{EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION}
environment variable to disable native compilation.
@@ -1069,9 +1077,19 @@ pristine environment, that may not be true for the
subprocess.
@end defopt
@defopt native-comp-async-query-on-exit
-If this variable's value is non-nil, Emacs will query upon exiting
+If this variable's value is non-@code{nil}, Emacs will query upon exiting
whether to exit and kill any asynchronous native-compilation
subprocesses that are still running, thus preventing the corresponding
@file{.eln} files from being written. If the value is @code{nil}, the
default, Emacs will kill these subprocesses without querying.
@end defopt
+
+The variable @code{native-comp-eln-load-path} holds the list of
+directories where Emacs looks for the @file{*.eln} files
+(@pxref{Library Search}); in that role it is the equivalent of
+@code{load-path} used to look for @file{*.el} and @file{*.elc} files.
+The directories in this list are also used for writing the
+@file{*.eln} files produced by asynchronous native-compilation;
+specifically, Emacs will write these files into the first writable
+directory in the list. Thus, you can control where native-compilation
+stores the results by changing the value of this variable.
diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 9035e7f6bb..3c874ee3fe 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1534,7 +1534,7 @@ iterator with @code{iter-next} for anything interesting
to happen.
Each call to a generator function produces a @emph{different}
iterator, each with its own state.
-@defun iter-next iterator value
+@defun iter-next iterator &optional value
Retrieve the next value from @var{iterator}. If there are no more
values to be generated (because @var{iterator}'s generator function
returned), @code{iter-next} signals the @code{iter-end-of-sequence}
diff --git a/doc/lispref/customize.texi b/doc/lispref/customize.texi
index 6ba35cffff..204719e942 100644
--- a/doc/lispref/customize.texi
+++ b/doc/lispref/customize.texi
@@ -1428,12 +1428,32 @@ emacs, The GNU Emacs Manual}.)
be a call to @code{deftheme}, and the last form should be a call to
@code{provide-theme}.
-@defmac deftheme theme &optional doc
+@defmac deftheme theme &optional doc &rest properties
This macro declares @var{theme} (a symbol) as the name of a Custom
theme. The optional argument @var{doc} should be a string describing
the theme; this is the description shown when the user invokes the
@code{describe-theme} command or types @kbd{?} in the @samp{*Custom
-Themes*} buffer.
+Themes*} buffer. The remaining arguments @var{properties} are used
+pass a property list with theme attributes.
+
+The following attributes are supported:
+
+@table @code
+@item :family
+A symbol designating what ``family'' a theme belongs to. A
+@dfn{family} of themes is a set of similar themes that differ by minor
+aspects, such as face colors that are meant for the light vs dark
+background of the frame.
+@item :kind
+A symbol. If a theme is enabled and this property has the value
+@code{color-scheme}, then the @code{theme-choose-variant} command will
+look for other available themes that belong to the same family in
+order to switch the themes. Other values are currently unspecified
+and should not be used.
+@item :background-mode
+A symbol, either @code{light} or @code{dark}. This attribute is
+currently unused, but should still be specified.
+@end table
Two special theme names are disallowed (using them causes an error):
@code{user} is a dummy theme that stores the user's direct
diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 64400ef931..10a1a18dd1 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -548,7 +548,7 @@ previous example as follows:
@end example
@end defmac
-@defmac dolist-with-progress-reporter (var count [result]) reporter-or-message
body@dots{}
+@defmac dolist-with-progress-reporter (var list [result]) reporter-or-message
body@dots{}
This is another convenience macro that works the same way as @code{dolist}
does, but also reports loop progress using the functions described
above. As in @code{dotimes-with-progress-reporter},
@@ -2273,7 +2273,7 @@ complex text shaping requires that for some scripts.
When that
happens, characters no longer map in a simple way to display columns,
and display layout decisions with such strings, such as truncating too
wide strings, can be a complex job. This function helps in performing
-suvh jobs: it splits up its argument @var{string} into a list of
+such jobs: it splits up its argument @var{string} into a list of
substrings, where each substring produces a single grapheme cluster
that should be displayed as a unit. Lisp programs can then use this
list to construct visually-valid substrings of @var{string} which will
@@ -2587,7 +2587,7 @@ meaning the foreground color of the face. Omitting the
attribute
@code{:color} means to use the foreground color of the face.
@var{style} should be a symbol @code{line} or @code{wave}, meaning to
use a straight or wavy line. Omitting the attribute @code{:style}
-means to use a straight line. @var{position}, if non-nil, means to
+means to use a straight line. @var{position}, if non-@code{nil}, means to
display the underline at the descent of the text, instead of at the
baseline level. If it is a number, then it specifies the amount of
pixels above the descent to display the underline.
@@ -7347,7 +7347,7 @@ Display the next search result in @var{xwidget}. This
function will
signal an error if a search query has not been already started in
@var{xwidget} through @code{xwidget-webkit-search}.
-If @code{wrap-around} was non-nil when @code{xwidget-webkit-search}
+If @code{wrap-around} was non-@code{nil} when @code{xwidget-webkit-search}
was called, then the search will restart from the beginning of the
document when its end is reached.
@end defun
@@ -7357,7 +7357,7 @@ Display the previous search result in @var{xwidget}.
This function
signals an error if a search query has not been already started in
@var{xwidget} through @code{xwidget-webkit-search}.
-If @code{wrap-around} was non-nil when @code{xwidget-webkit-search}
+If @code{wrap-around} was non-@code{nil} when @code{xwidget-webkit-search}
was called, then the search will restart from the end of the
document when its beginning is reached.
@end defun
diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi
index 6a51489d8a..1562a37842 100644
--- a/doc/lispref/edebug.texi
+++ b/doc/lispref/edebug.texi
@@ -1076,16 +1076,25 @@ current buffer, are saved and restored.
@cindex window configuration (Edebug)
The outside window configuration is saved and restored if
@code{edebug-save-windows} is non-@code{nil} (@pxref{Edebug Options}).
+If the value of @code{edebug-save-windows} is a list, only the listed
+windows are saved and restored.
The window configuration is not restored on error or quit, but the
outside selected window @emph{is} reselected even on error or quit in
-case a @code{save-excursion} is active. If the value of
-@code{edebug-save-windows} is a list, only the listed windows are saved
-and restored.
+case a @code{save-excursion} is active.
The window start and horizontal scrolling of the source code buffer are
not restored, however, so that the display remains coherent within Edebug.
+@cindex buffer point changed by Edebug
+@cindex edebug overwrites buffer point position
+Saving and restoring the outside window configuration can sometimes
+change the positions of point in the buffers on which the Lisp program
+you are debugging operates, especially if your program moves point.
+If this happens and interferes with your debugging, we recommend to
+set @code{edebug-save-windows} to @code{nil}
+(@pxref{Edebug Options}).
+
@item
The value of point in each displayed buffer is saved and restored if
@code{edebug-save-displayed-buffer-points} is non-@code{nil}.
@@ -1655,10 +1664,16 @@ specify an Edebug form specification.
If this is non-@code{nil}, Edebug saves and restores the window
configuration. That takes some time, so if your program does not care
what happens to the window configurations, it is better to set this
-variable to @code{nil}.
-
-If the value is a list, only the listed windows are saved and
-restored.
+variable to @code{nil}. We also recommend to set this to @code{nil}
+if the default value causes Edebug to overwrite the positions of point
+in buffers that are involved in the program you are debugging, as
+result of saving and restoring the window configuration; this could
+happen if your program moves point in one or more of those buffers.
+Another option to try to customize in this case is
+@code{edebug-save-displayed-buffer-points}, described below.
+
+If the value of @code{edebug-save-windows} is a list, only the listed
+windows are saved and restored.
You can use the @kbd{W} command in Edebug to change this variable
interactively. @xref{Edebug Display Update}.
diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi
index 44a62dcebc..cb05290abd 100644
--- a/doc/lispref/errors.texi
+++ b/doc/lispref/errors.texi
@@ -242,7 +242,7 @@ The message is @samp{Cannot determine image type}.
@xref{Images}.
@item inhibited-interaction
The message is @samp{User interaction while inhibited}. This error is
-signalled when @code{inhibit-interaction} is non-@code{nil} and a user
+signaled when @code{inhibit-interaction} is non-@code{nil} and a user
interaction function (like @code{read-from-minibuffer}) is called.
@end table
diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi
index e1aa2de523..183b2786ea 100644
--- a/doc/lispref/files.texi
+++ b/doc/lispref/files.texi
@@ -1253,14 +1253,6 @@ the @samp{smb} method. For all other connection
methods, runtime
tests are performed.
@end defun
-@defun file-in-directory-p file dir
-This function returns @code{t} if @var{file} is a file in directory
-@var{dir}, or in a subdirectory of @var{dir}. It also returns
-@code{t} if @var{file} and @var{dir} are the same directory. It
-compares the truenames of the two directories. If @var{dir} does not
-name an existing directory, the return value is @code{nil}.
-@end defun
-
@defun vc-responsible-backend file
This function determines the responsible VC backend of the given
@var{file}. For example, if @file{emacs.c} is a file tracked by Git,
@@ -1412,14 +1404,17 @@ The file's inode number
(@code{file-attribute-inode-number}),
a nonnegative integer.
@item
-The filesystem number of the device that the file is on
-@code{file-attribute-device-number}), an integer.
-This element and the file's inode number
-together give enough information to distinguish any two files on the
-system---no two files can have the same values for both of these
-numbers.
+The filesystem's identifier of the device that the file is on
+(@code{file-attribute-device-number}), an integer or a cons cell of
+two integers. The latter is sometimes used by remote files, in order
+to distinguish remote filesystems from local ones.
@end enumerate
+The file's inode and device together give enough information
+to distinguish any two files on the system---no two files can have the
+same values for both of these attributes. This tuple that uniquely
+identifies the file is returned by @code{file-attribute-file-identifier}.
+
For example, here are the file attributes for @file{files.texi}:
@example
@@ -3100,6 +3095,17 @@ is called with one argument (the file or directory) and
should return
non-@code{nil} if that directory is the one it is looking for.
@end defun
+@cindex parent directory of file
+@cindex ancestor directory of file
+@cindex file, ancestor directory of
+@defun file-in-directory-p file dir
+This function returns @code{t} if @var{file} is a file in directory
+@var{dir}, or in a subdirectory of @var{dir}. It also returns
+@code{t} if @var{file} and @var{dir} are the same directory. It
+compares the truenames of the two directories. If @var{dir} does not
+name an existing directory, the return value is @code{nil}.
+@end defun
+
@defun directory-files-and-attributes directory &optional full-name
match-regexp nosort id-format count
This is similar to @code{directory-files} in deciding which files
to report on and how to report their names. However, instead
@@ -3130,7 +3136,7 @@ a list of file names that match it.
@var{pattern} is, by default, a ``glob''/wildcard string, e.g.,
@samp{"/tmp/*.png"} or @samp{"/*/*/foo.png"}, but can also be a
-regular expression if the optional @var{regexp} parameter is non-nil.
+regular expression if the optional @var{regexp} parameter is non-@code{nil}.
In any case, the matches are applied per sub-directory, so a match
can't span a parent/sub directory.
diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi
index 8db6ad0fd3..b3f1a29ae8 100644
--- a/doc/lispref/frames.texi
+++ b/doc/lispref/frames.texi
@@ -4058,70 +4058,89 @@ amount of different data types on the clipboard.
When the user drops something from another application over Emacs,
Emacs will try to insert any text and open any URL that was dropped.
If text was dropped, then it will always be inserted at the location
-of the mouse pointer when the drop happened, or saved in the kill ring
-if insertion failed (which can happen if the buffer is read-only). If
-it was an URL, then Emacs tries to call an appropriate handler
-function by first matching the URL against regexps defined in
-@code{dnd-protocol-alist}, and then against @code{browse-url-handlers}
-and @code{browse-url-default-handlers}, and failing that, inserting
-the URL as plain text.
+of the mouse pointer where the drop happened, or saved in the kill
+ring if insertion failed, which could happen if the buffer was
+read-only. If a URL was dropped instead, then Emacs will first try to
+call an appropriate handler function by matching the URL against
+regexps defined in the variable @code{dnd-protocol-alist}, and then
+against those defined in the variables @code{browse-url-handlers} and
+@code{browse-url-default-handlers}. Should no suitable handler be
+located, Emacs will fall back to inserting the URL as plain text.
@defvar dnd-protocol-alist
This variable is a list of cons cells of the form
@w{@code{(@var{pattern} . @var{action})}}. @var{pattern} is a regexp
that URLs are matched against after being dropped. @var{action} is a
-function that is called with two arguments should a URL being dropped
+function that is called with two arguments, should a URL being dropped
match @var{pattern}: the URL being dropped, and the action being
-performed for the drop (one of the symbols @code{copy}, @code{move},
-@code{link}, @code{private} or @code{ask}).
+performed for the drop, which is one of the symbols @code{copy},
+@code{move}, @code{link}, @code{private} or @code{ask}.
+
+If @var{action} is @var{private}, then it means the program that
+initiated the drop wants Emacs to perform an unspecified action with
+the URL; a reasonable action to perform in that case is to open the URL
+or copy its contents into the current buffer. Otherwise, @var{action}
+has the same meaning as the @var{action} argument to
+@code{dnd-begin-file-drag}.
@end defvar
@cindex drag and drop, X
@cindex drag and drop, other formats
- Emacs implements drag-and-drop for text and URLs individually for
-each window system, and does not by default support the dropping of
-anything else. Code that wishes to support the dropping of content
-types not supported by Emacs can utilize the X-specific interface
-described below:
+ Emacs implements receiving text and URLs individually for each
+window system, and does not by default support receiving other kinds
+of data as drops. To support receiving other kinds of data, use the
+X-specific interface described below:
@vindex x-dnd-test-function
@vindex x-dnd-known-types
- When a user drags something from another application over Emacs on
-the X Window System, that other application expects Emacs to tell it
-if Emacs can handle the data that was dragged. The variable
-@code{x-dnd-test-function} is used by Emacs to determine what to
-reply. The default value is @code{x-dnd-default-test-function} which
-accepts drops if the type of the data to be dropped is present in
-@code{x-dnd-known-types}. You can customize
-@code{x-dnd-test-function} and/or @code{x-dnd-known-types} if you want
-Emacs to accept or reject drops based on some other criteria.
+ When a user drags something from another application over Emacs
+under the X Window System, that other application expects Emacs to
+tell it if Emacs understands the data being dragged. The function in
+the variable @code{x-dnd-test-function} is called by Emacs to
+determine what to reply to any such inquiry. The default value is
+@code{x-dnd-default-test-function}, which accepts drops if the type of
+the data to be dropped is present in @code{x-dnd-known-types}.
+Changing the variables @code{x-dnd-test-function} and
+@code{x-dnd-known-types} can make Emacs accept or reject drops based
+on some other criteria.
@vindex x-dnd-types-alist
- If you want to change the way Emacs handles drop of different types
-or add a new type, customize @code{x-dnd-types-alist}. This requires
-detailed knowledge of what types other applications use for drag and
-drop.
-
- Those data types are typically implemented as special data types an
-X selection provided by the other application can be converted to.
-They can either be the same data types that are typically accepted by
-@code{gui-set-selection}, or they can be MIME types, depending on the
-specific drag-n-drop protocol being used. Plain text may be
-@code{"STRING"} or @code{"text/plain"}, for example.
+ If you want to change the way Emacs receives drops of different data
+types, or you want to enable it to understand a new type, change the variable
+@code{x-dnd-types-alist}. Doing so correctly requires detailed
+knowledge of what data types other applications use for drag and drop.
+
+ These data types are typically implemented as special data types
+that can be obtained from an X selection provided by the other
+application. In most cases, they are either the same data types that
+are typically accepted by @code{gui-set-selection}, or MIME types,
+depending on the specific drag-and-drop protocol being used. For
+example, the data type used for plain text may be either
+@code{"STRING"} or @code{"text/plain"}.
@vindex x-dnd-direct-save-function
+@c FIXME: This description is overly-complicated and confusing. In
+@c particular, the two calls to the function basically sound
+@c identical, so it is unclear how should the function distinguish
+@c between the first and the second one. The description of who asks
+@c whom to do what is also very hard to understand. Needs rewording,
+@c and needs shorter sentences. Perhaps examples could help.
However, @code{x-dnd-types-alist} does not handle a special kind of
-drop sent by a program which wants Emacs to save a file in a location
-Emacs must determine by itself. These drops are handled via the
-variable @code{x-dnd-direct-save-function}, which should be a function
-that accepts two arguments. If the first argument is non-@code{nil},
-then the second argument is a string describing the name (with no
-leading directory) that the other program recommends the file be saved
-under, and the function should return the complete file name under
-which it will be saved. Otherwise, the file has already been saved,
-and the second argument is the complete name of the file. The
-function should then perform whatever action is appropriate (i.e.,
-open the file or refresh the directory listing.)
+drop sent by a program that wants Emacs to tell it where to save a
+file in a specific location determined by the user. These drops are
+instead handled by a function that is the value of the variable
+@code{x-dnd-direct-save-function}. This function should accept two arguments.
+If the first argument is non-@code{nil}, then the second argument is a
+file name to save (with leading directories) that the other
+program recommends, and the
+function should return the full file name under which it should be
+saved. After the function completes, Emacs will ask the other program
+to save the file under the name that was returned, and if the file was
+successfully saved, call the function again with the first argument
+set to a non-@code{nil} value and the second argument set to the file
+name that was returned. The function should then perform whatever
+action is appropriate (i.e., opening the file or refreshing a
+directory listing.)
@cindex initiating drag-and-drop
On capable window systems, Emacs also supports dragging contents
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 8b858e0aa0..9d5a266191 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -533,6 +533,44 @@ Instead, use the @code{advertised-calling-convention}
declaration
compiler emit a warning message when it compiles Lisp programs which
use the deprecated calling convention.
+@cindex computed documentation string
+@kindex :documentation
+Documentation strings are usually static, but occasionally it can be
+necessary to generate them dynamically. In some cases you can do so
+by writing a macro which generates at compile time the code of the
+function, including the desired documentation string. But you can
+also generate the docstring dynamically by writing
+@code{(:documentation @var{form})} instead of the documentation
+string. This will evaluate @var{form} at run-time when the function
+is defined and use it as the documentation string@footnote{This only
+works in code using @code{lexical-binding}.}. You can also compute
+the documentation string on the fly when it is requested, by setting
+the @code{function-documentation} property of the function's symbol to
+a Lisp form that evaluates to a string.
+
+For example:
+@example
+@group
+(defun adder (x)
+ (lambda (y)
+ (:documentation (format "Add %S to the argument Y." x))
+ (+ x y)))
+(defalias 'adder5 (adder 5))
+(documentation 'adder5)
+ @result{} "Add 5 to the argument Y."
+@end group
+
+@group
+(put 'adder5 'function-documentation
+ '(concat (documentation (symbol-function 'adder5) 'raw)
+ " Consulted at " (format-time-string "%H:%M:%S")))
+(documentation 'adder5)
+ @result{} "Add 5 to the argument Y. Consulted at 15:52:13"
+(documentation 'adder5)
+ @result{} "Add 5 to the argument Y. Consulted at 15:52:18"
+@end group
+@end example
+
@node Function Names
@section Naming a Function
@cindex function definition
@@ -696,7 +734,7 @@ a list of symbols representing the function alias chain,
else
@result{} (b c)
@end example
-If there's a loop in the definitions, an error will be signalled. If
+If there's a loop in the definitions, an error will be signaled. If
@var{noerror} is non-@code{nil}, the non-looping parts of the chain is
returned instead.
@end defun
diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi
index 65ad5f0554..ee6fdb0dbb 100644
--- a/doc/lispref/help.texi
+++ b/doc/lispref/help.texi
@@ -980,8 +980,8 @@ In addition to function descriptions, the list can also
have string
elements, which are used to divide a documentation group into
sections.
-@defun shortdoc-add-function shortdoc-add-function group section elem
-Lisp packages can add functions to groups with this command. Each
+@defun shortdoc-add-function group section elem
+Lisp packages can add functions to groups with this function. Each
@var{elem} should be a function description, as described above.
@var{group} is the function group, and @var{section} is what section
in the function group to insert the function into.
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index ea1679f693..4640b6d759 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -554,12 +554,17 @@ trigger another garbage collection. You can use the
result returned by
object type; space allocated to the contents of buffers does not count.
The initial threshold value is @code{GC_DEFAULT_THRESHOLD}, defined in
-@file{alloc.c}. Since it's defined in @code{word_size} units, the value
-is 400,000 for the default 32-bit configuration and 800,000 for the 64-bit
-one. If you specify a larger value, garbage collection will happen less
-often. This reduces the amount of time spent garbage collecting, but
-increases total memory use. You may want to do this when running a program
-that creates lots of Lisp data.
+@file{alloc.c}. Since it's defined in @code{word_size} units, the
+value is 400,000 for the default 32-bit configuration and 800,000 for
+the 64-bit one. If you specify a larger value, garbage collection
+will happen less often. This reduces the amount of time spent garbage
+collecting, but increases total memory use. You may want to do this
+when running a program that creates lots of Lisp data. However, we
+recommend against increasing the threshold for prolonged periods of
+time, and advise that you never set it higher than needed for the
+program to run in reasonable time. Using thresholds higher than
+necessary could potentially cause system-wide memory pressure, and
+should therefore be avoided.
You can make collections more frequent by specifying a smaller value, down
to 1/10th of @code{GC_DEFAULT_THRESHOLD}. A value less than this minimum
@@ -576,6 +581,9 @@ garbage collection occurs only when both criteria are
satisfied.
As the heap size increases, the time to perform a garbage collection
increases. Thus, it can be desirable to do them less frequently in
proportion.
+
+As with @code{gc-cons-threshold}, do not enlarge this more than
+necessary, and never for prolonged periods of time.
@end defopt
Control over the garbage collector via @code{gc-cons-threshold} and
diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi
index 975215d697..eccc8deb63 100644
--- a/doc/lispref/intro.texi
+++ b/doc/lispref/intro.texi
@@ -34,7 +34,9 @@ specifically to editing.
This is
@iftex
+@ifset VERSION
edition @value{VERSION} of
+@end ifset
@end iftex
the @cite{GNU Emacs Lisp Reference Manual},
corresponding to Emacs version @value{EMACSVER}.
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 5c5c615f85..30f65e359a 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1961,12 +1961,12 @@ and later discarded; this is not possible with a
property list.
@cindex accessing plist properties
The following functions can be used to manipulate property lists.
-They all compare property names using @code{eq}.
+They all default to comparing property names using @code{eq}.
@defun plist-get plist property &optional predicate
This returns the value of the @var{property} property stored in the
property list @var{plist}. Comparisons are done with @var{predicate},
-and defaults to @code{eq}. It accepts a malformed @var{plist}
+which defaults to @code{eq}. It accepts a malformed @var{plist}
argument. If @var{property} is not found in the @var{plist}, it
returns @code{nil}. For example,
@@ -1985,7 +1985,7 @@ returns @code{nil}. For example,
@defun plist-put plist property value &optional predicate
This stores @var{value} as the value of the @var{property} property in
the property list @var{plist}. Comparisons are done with @var{predicate},
-and defaults to @code{eq}. It may modify @var{plist} destructively,
+which defaults to @code{eq}. It may modify @var{plist} destructively,
or it may construct a new list structure without altering the old. The
function returns the modified property list, so you can store that back
in the place where you got @var{plist}. For example,
@@ -2012,7 +2012,7 @@ compares properties using @code{equal} instead of
@code{eq}.
@defun plist-member plist property &optional predicate
This returns non-@code{nil} if @var{plist} contains the given
-@var{property}. Comparisons are done with @var{predicate}, and
+@var{property}. Comparisons are done with @var{predicate}, which
defaults to @code{eq}. Unlike @code{plist-get}, this allows you to
distinguish between a missing property and a property with the value
@code{nil}. The value is actually the tail of @var{plist} whose
diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 4e4f12dc32..c7fbdac1d7 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -662,7 +662,7 @@ and @code{define-overloadable-function} (see the commentary
in
and @code{define-global-minor-mode}.
@item Other definition types:
-@code{defcustom}, @code{defgroup}, @code{defclass}
+@code{defcustom}, @code{defgroup}, @code{deftheme}, @code{defclass}
(@pxref{Top,EIEIO,,eieio,EIEIO}), and @code{define-skeleton}
(@pxref{Top,Autotyping,,autotype,Autotyping}).
@end table
diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 089ae41f32..332a453619 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -2745,7 +2745,7 @@ Here's a typical use case:
If @code{my-client-handling-function} ends up calling something that
asks the user for something (via @code{y-or-n-p} or
@code{read-from-minibuffer} or the like), an
-@code{inhibited-interaction} error is signalled instead. The server
+@code{inhibited-interaction} error is signaled instead. The server
code then catches that error and reports it to the client.
@node Minibuffer Misc
diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi
index 543fc48dd7..b334105f1e 100644
--- a/doc/lispref/modes.texi
+++ b/doc/lispref/modes.texi
@@ -198,7 +198,7 @@ on the hook. The optional argument @var{depth} lets you
indicate where the
function should be inserted in the list: it should then be a number
between -100 and 100 where the higher the value, the closer to the end of the
list the function should go. The @var{depth} defaults to 0 and for backward
-compatibility when @var{depth} is a non-nil symbol it is interpreted as a depth
+compatibility when @var{depth} is a non-@code{nil} symbol it is interpreted as
a depth
of 90. Furthermore, when @var{depth} is strictly greater than 0 the function
is added @emph{after} rather than before functions of the same depth.
One should never use a depth of 100 (or -100), because one can never be
@@ -1256,7 +1256,7 @@ will be a vector for the ID at @var{pos}. If there is no
entry at
@vindex tabulated-list-use-header-line
@defun tabulated-list-header-overlay-p &optional POS
-This @code{defsubst} returns non-nil if there is a fake header at
+This @code{defsubst} returns non-@code{nil} if there is a fake header at
@var{pos}. A fake header is used if
@code{tabulated-list-use-header-line} is @code{nil} to put the column
names at the beginning of the buffer. If omitted or @code{nil},
@@ -1269,7 +1269,7 @@ This function puts @var{tag} in the padding area of the
current line.
The padding area can be empty space at the beginning of the line, the
width of which is governed by @code{tabulated-list-padding}.
@var{tag} should be a string, with a length less than or equal to
-@code{tabulated-list-padding}. If @var{advance} is non-nil, this
+@code{tabulated-list-padding}. If @var{advance} is non-@code{nil}, this
function advances point by one line.
@end defun
@@ -1284,7 +1284,7 @@ This function changes the tabulated list entry at point,
setting
the name of the column to change. @var{desc} is the new column
descriptor, which is inserted via @code{tabulated-list-print-col}.
-If @var{change-entry-data} is non-nil, this function modifies the
+If @var{change-entry-data} is non-@code{nil}, this function modifies the
underlying data (usually the column descriptor in the list
@code{tabulated-list-entries}) by setting the column descriptor of the
vector to @code{desc}.
@@ -1851,7 +1851,9 @@ to enable or disable the buffer-local minor mode
@var{mode} in all (or
some; see below) buffers. It also executes the @var{body} forms. To
turn on the minor mode in a buffer, it uses the function
@var{turn-on}; to turn off the minor mode, it calls @var{mode} with
-@minus{}1 as argument.
+@minus{}1 as argument. (The function @var{turn-on} is a separate
+function so it could determine whether to enable the minor mode or not
+when it is not a priori clear that it should always be enabled.)
Globally enabling the mode also affects buffers subsequently created
by visiting files, and buffers that use a major mode other than
@@ -3150,9 +3152,10 @@ match found by @var{matcher} acts as the anchor for
further searches
specified by @var{anchored-highlighter}. @var{anchored-highlighter}
is a list of the following form:
+@c Don't wrap the line in the next @example, because that tends to
+@c produce ugly indentation in Info
@example
-(@var{anchored-matcher} @var{pre-form} @var{post-form}
- @var{subexp-highlighters}@dots{})
+(@var{anchored-matcher} @var{pre-form} @var{post-form}
@var{subexp-highlighters}@dots{})
@end example
Here, @var{anchored-matcher}, like @var{matcher}, is either a regular
diff --git a/doc/lispref/numbers.texi b/doc/lispref/numbers.texi
index fdcda328d8..2c7a1d3266 100644
--- a/doc/lispref/numbers.texi
+++ b/doc/lispref/numbers.texi
@@ -1238,6 +1238,9 @@ any given seed, the @code{random} function always
generates the same
sequence of numbers. By default, Emacs initializes the random seed at
startup, in such a way that the sequence of values of @code{random}
(with overwhelming likelihood) differs in each Emacs run.
+The random seed is typically initialized from system entropy;
+however, on obsolescent platforms lacking entropy pools,
+the seed is taken from less-random volatile data such as the current time.
Sometimes you want the random number sequence to be repeatable. For
example, when debugging a program whose behavior depends on the random
@@ -1256,12 +1259,45 @@ nonnegative and less than @var{limit}. Otherwise, the
value might be
any fixnum, i.e., any integer from @code{most-negative-fixnum} through
@code{most-positive-fixnum} (@pxref{Integer Basics}).
-If @var{limit} is @code{t}, it means to choose a new seed as if Emacs
-were restarting, typically from the system entropy. On systems
-lacking entropy pools, choose the seed from less-random volatile data
-such as the current time.
-
If @var{limit} is a string, it means to choose a new seed based on the
-string's contents.
+string's contents. This causes later calls to @code{random} to return
+a reproducible sequence of results.
+
+If @var{limit} is @code{t}, it means to choose a new seed as if Emacs
+were restarting. This causes later calls to @code{random} to return
+an unpredictable sequence of results.
@end defun
+
+If you need a random nonce for cryptographic purposes, using
+@code{random} is typically not the best approach, for several reasons:
+
+@itemize @bullet
+@item
+Although you can use @code{(random t)} to consult system entropy,
+doing so can adversely affect other parts of your program that benefit
+from reproducible results.
+
+@item
+The system-dependent pseudo-random number generator (PRNG) used by
+@code{random} is not necessarily suitable for cryptography.
+
+@item
+A call to @code{(random t)} does not give direct access to system
+entropy; the entropy is passed through the system-dependent PRNG, thus
+possibly biasing the results.
+
+@item
+On typical platforms the random seed contains only 32 bits, which is
+typically narrower than an Emacs fixnum, and is not nearly enough for
+cryptographic purposes.
+
+@item
+A @code{(random t)} call leaves information about the nonce scattered
+about Emacs's internal state, increasing the size of the internal
+attack surface.
+
+@item
+On obsolescent platforms lacking entropy pools, @code{(random t)} is
+seeded from a cryptographically weak source.
+@end itemize
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index db6b4c35ef..adc6909aca 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -507,7 +507,7 @@ 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
+Setting this user option to non-@code{nil} forces @code{process-file} to
interpret such exit codes as signals, and to return a corresponding
string.
@end defopt
@@ -2585,6 +2585,10 @@ that are mainly relevant to encrypted connections:
@item :nowait @var{boolean}
If non-@code{nil}, try to make an asynchronous connection.
+@item :noquery @var{query-flag}
+Initialize the process query flag to @var{query-flag}.
+@xref{Query Before Exit}.
+
@item :coding @var{coding}
Use this to set the coding systems used by the network process, in
preference to binding @code{coding-system-for-read} or
diff --git a/doc/lispref/searching.texi b/doc/lispref/searching.texi
index 5ee139a11d..ad7f2856de 100644
--- a/doc/lispref/searching.texi
+++ b/doc/lispref/searching.texi
@@ -395,13 +395,12 @@ range should not be the starting point of another one;
for example,
@samp{[a-m-z]} should be avoided.
A character alternative can also specify named character classes
-(@pxref{Char Classes}). This is a POSIX feature. For example,
-@samp{[[:ascii:]]} matches any @acronym{ASCII} character.
-Using a character class is equivalent to mentioning each of the
-characters in that class; but the latter is not feasible in practice,
-since some classes include thousands of different characters.
-A character class should not appear as the lower or upper bound
-of a range.
+(@pxref{Char Classes}). For example, @samp{[[:ascii:]]} matches any
+@acronym{ASCII} character. Using a character class is equivalent to
+mentioning each of the characters in that class; but the latter is not
+feasible in practice, since some classes include thousands of
+different characters. A character class should not appear as the
+lower or upper bound of a range.
The usual regexp special characters are not special inside a
character alternative. A completely different set of characters is
@@ -617,7 +616,7 @@ This matches any character whose code is in the range 0--31.
This matches @samp{0} through @samp{9}. Thus, @samp{[-+[:digit:]]}
matches any digit, as well as @samp{+} and @samp{-}.
@item [:graph:]
-This matches graphic characters---everything except whitespace,
+This matches graphic characters---everything except spaces,
@acronym{ASCII} and non-@acronym{ASCII} control characters,
surrogates, and codepoints unassigned by Unicode, as indicated by the
Unicode @samp{general-category} property (@pxref{Character
@@ -625,29 +624,39 @@ Properties}).
@item [:lower:]
This matches any lower-case letter, as determined by the current case
table (@pxref{Case Tables}). If @code{case-fold-search} is
-non-@code{nil}, this also matches any upper-case letter.
+non-@code{nil}, this also matches any upper-case letter. Note that a
+buffer can have its own local case table different from the default
+one.
@item [:multibyte:]
This matches any multibyte character (@pxref{Text Representations}).
@item [:nonascii:]
This matches any non-@acronym{ASCII} character.
@item [:print:]
-This matches any printing character---either whitespace, or a graphic
-character matched by @samp{[:graph:]}.
+This matches any printing character---either spaces or graphic
+characters matched by @samp{[:graph:]}.
@item [:punct:]
This matches any punctuation character. (At present, for multibyte
-characters, it matches anything that has non-word syntax.)
+characters, it matches anything that has non-word syntax, and thus its
+exact definition can vary from one major mode to another, since the
+syntax of a character depends on the major mode.)
@item [:space:]
This matches any character that has whitespace syntax
-(@pxref{Syntax Class Table}).
+(@pxref{Syntax Class Table}). Note that the syntax of a character,
+and thus which characters are considered ``whitespace'',
+depends on the major mode.
@item [:unibyte:]
This matches any unibyte character (@pxref{Text Representations}).
@item [:upper:]
This matches any upper-case letter, as determined by the current case
table (@pxref{Case Tables}). If @code{case-fold-search} is
-non-@code{nil}, this also matches any lower-case letter.
+non-@code{nil}, this also matches any lower-case letter. Note that a
+buffer can have its own local case table different from the default
+one.
@item [:word:]
This matches any character that has word syntax (@pxref{Syntax Class
-Table}).
+Table}). Note that the syntax of a character, and thus which
+characters are considered ``word-constituent'', depends on the major
+mode.
@item [:xdigit:]
This matches the hexadecimal digits: @samp{0} through @samp{9}, @samp{a}
through @samp{f} and @samp{A} through @samp{F}.
@@ -1052,11 +1061,15 @@ customization.
@subsubsection Constructs in @code{rx} regexps
The various forms in @code{rx} regexps are described below. The
-shorthand @var{rx} represents any @code{rx} form, and @var{rx}@dots{}
-means zero or more @code{rx} forms. These are all valid arguments to
-the @code{rx} macro. Where the corresponding string
-regexp syntax is given, @var{A}, @var{B}, @dots{} are string regexp
-subexpressions.
+shorthand @var{rx} represents any @code{rx} form. @var{rx}@dots{}
+means zero or more @code{rx} forms and, unless stated otherwise,
+matches these forms in sequence as if wrapped in a @code{(seq @dots{})}
+subform.
+
+These are all valid arguments to the @code{rx} macro. All forms are
+defined by their described semantics; the corresponding string regexps
+are provided for ease of understanding only. @var{A}, @var{B}, @dots{}
+denote (suitably bracketed) string regexp subexpressions therein.
@subsubheading Literals
@@ -1290,12 +1303,12 @@ Match any character that has whitespace syntax
@item @code{lower}, @code{lower-case}
Match anything lower-case, as determined by the current case table.
-If @code{case-fold-search} is non-nil, this also matches any
+If @code{case-fold-search} is non-@code{nil}, this also matches any
upper-case letter.
@item @code{upper}, @code{upper-case}
Match anything upper-case, as determined by the current case table.
-If @code{case-fold-search} is non-nil, this also matches any
+If @code{case-fold-search} is non-@code{nil}, this also matches any
lower-case letter.
@item @code{graph}, @code{graphic}
diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi
index cf961e9e7c..4454188cc4 100644
--- a/doc/lispref/strings.texi
+++ b/doc/lispref/strings.texi
@@ -484,7 +484,7 @@ is a multibyte string, we recommend to make sure
@var{string} is also
multibyte, even if it's pure-@acronym{ASCII}.
Since it is impossible to change the number of characters in an
-existing string, it is en error if @var{obj} consists of more
+existing string, it is an error if @var{obj} consists of more
characters than would fit in @var{string} starting at character index
@var{idx}.
@end defun
diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi
index ea1e086ebf..2ef4f8c291 100644
--- a/doc/lispref/symbols.texi
+++ b/doc/lispref/symbols.texi
@@ -718,9 +718,9 @@ byte-compiling any of the two files has equivalent results.
The
shorthands @code{snu-split} and @code{snu-lines} used in the second
version are @emph{not} interned in the obarray. This is easily seen
by moving point to the location where the shorthands are used and
-waiting for ElDoc (@pxref{Lisp Doc, , Local Variables in Files, emacs,
-The GNU Emacs Manual}) to hint at the true full name of the symbol
-under point in the echo area.
+waiting for ElDoc (@pxref{Programming Language Doc, , Local Variables
+in Files, emacs, The GNU Emacs Manual}) to hint at the true full name
+of the symbol under point in the echo area.
Since @code{read-symbol-shorthands} is a file-local variable, it is
possible that multiple libraries depending on
@@ -794,7 +794,7 @@ this case.
@end defvar
@defvar print-symbols-bare
-When bound to non-nil, the Lisp printer prints only the bare symbol of
+When bound to non-@code{nil}, the Lisp printer prints only the bare symbol of
a symbol with position, ignoring the position.
@end defvar
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 8b859042ad..793c22949c 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -1525,7 +1525,7 @@ Some commands leave the region active after execution in
such a way that
it interferes with selective undo of that command. To make @code{undo}
ignore the active region when invoked immediately after such a command,
set the property @code{undo-inhibit-region} of the command's function
-symbol to a non-nil value. @xref{Standard Properties}.
+symbol to a non-@code{nil} value. @xref{Standard Properties}.
@node Maintaining Undo
@section Maintaining Undo Lists
@@ -4876,7 +4876,7 @@ If the optional argument @var{no-pad} is non-@code{nil}
then this
function doesn't generate the padding.
@end defun
-@deffn Command base64-decode-region beg end &optional base64url
+@deffn Command base64-decode-region beg end &optional base64url ignore-invalid
This function converts the region from @var{beg} to @var{end} from base
64 code into the corresponding decoded text. It returns the length of
the decoded text.
@@ -4885,9 +4885,11 @@ The decoding functions ignore newline characters in the
encoded text.
If optional argument @var{base64url} is non-@code{nil}, then padding
is optional, and the URL variant of base 64 encoding is used.
+If optional argument @var{ignore-invalid} is non-@code{nil}, then any
+unrecognized characters are ignored.
@end deffn
-@defun base64-decode-string string &optional base64url
+@defun base64-decode-string string &optional base64url ignore-invalid
This function converts the string @var{string} from base 64 code into
the corresponding decoded text. It returns a unibyte string containing the
decoded text.
@@ -4897,6 +4899,8 @@ The decoding functions ignore newline characters in the
encoded text.
If optional argument @var{base64url} is non-@code{nil}, then padding
is optional, and the URL variant of base 64 encoding is used.
+If optional argument @var{ignore-invalid} is non-@code{nil}, then any
+unrecognized characters are ignored.
@end defun
@node Checksum/Hash
@@ -5321,9 +5325,12 @@ This has exactly the same effect as the previous
example, but is more
efficient and safer (because it doesn't involve any string parsing or
interpolation).
-@code{sqlite-execute} returns the number of affected rows. For
-instance, an @samp{insert} statement will return @samp{1}, whereas an
-@samp{update} statement may return zero or a higher number.
+@code{sqlite-execute} usually returns the number of affected rows.
+For instance, an @samp{insert} statement will typically return
+@samp{1}, whereas an @samp{update} statement may return zero or a
+higher number. However, when using @acronym{SQL} statements like
+@w{@samp{insert into @dots{} returning @dots{}}} and the like, the values
+specified by @w{@samp{returning @dots{}}} will be returned instead.
Strings in SQLite are, by default, stored as @code{utf-8}, and
selecting a text column will decode the string using that charset.
@@ -5919,7 +5926,7 @@ methods if these concepts apply to the transport. If
they do, then
any system resources (e.g.@: processes, timers, etc.) used to listen for
messages on the wire should be released in @code{jsonrpc-shutdown},
i.e.@: they should only be needed while @code{jsonrpc-running-p} is
-non-nil.
+non-@code{nil}.
@end enumerate
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index 1d891618da..7206f2acd2 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -1183,7 +1183,7 @@ Here is an example:
(let ((x 0)) ; @r{@code{x} is lexically bound.}
(setq my-ticker (lambda ()
(setq x (1+ x)))))
- @result{} (closure ((x . 0) t) ()
+ @result{} (closure ((x . 0)) ()
(setq x (1+ x)))
(funcall my-ticker)
@@ -2239,9 +2239,26 @@ still respecting file-local variables (@pxref{File Local
Variables}).
@cindex connection local variables
Connection-local variables provide a general mechanism for different
-variable settings in buffers with a remote connection. They are bound
+variable settings in buffers with a remote connection (@pxref{Remote
+Files,, Remote Files, emacs, The GNU Emacs Manual}). They are bound
and set depending on the remote connection a buffer is dedicated to.
+@menu
+* Connection Local Profiles:: Storing variable settings to
+ apply to connections.
+* Applying Connection Local Variables:: Using connection-local values
+ in your code.
+@end menu
+
+@node Connection Local Profiles
+@subsection Connection Local Profiles
+@cindex connection local profiles
+
+ Emacs uses connection-local profiles to store the variable settings
+to apply to particular connections. You can then associate these with
+remote connections by defining the criteria when they should apply,
+using @code{connection-local-set-profiles}.
+
@defun connection-local-set-profile-variables profile variables
This function defines a set of variable settings for the connection
@var{profile}, which is a symbol. You can later assign the connection
@@ -2311,13 +2328,13 @@ always applies. Example:
@example
@group
(connection-local-set-profiles
- '(:application 'tramp :protocol "ssh" :machine "localhost")
+ '(:application tramp :protocol "ssh" :machine "localhost")
'remote-bash 'remote-null-device)
@end group
@group
(connection-local-set-profiles
- '(:application 'tramp :protocol "sudo"
+ '(:application tramp :protocol "sudo"
:user "root" :machine "localhost")
'remote-ksh 'remote-null-device)
@end group
@@ -2329,13 +2346,13 @@ Therefore, the example above would be equivalent to
@example
@group
(connection-local-set-profiles
- '(:application 'tramp :protocol "ssh" :machine "localhost")
+ '(:application tramp :protocol "ssh" :machine "localhost")
'remote-bash)
@end group
@group
(connection-local-set-profiles
- '(:application 'tramp :protocol "sudo"
+ '(:application tramp :protocol "sudo"
:user "root" :machine "localhost")
'remote-ksh)
@end group
@@ -2356,6 +2373,14 @@ names. The function
@code{connection-local-set-profiles} updates this
list.
@end deffn
+@node Applying Connection Local Variables
+@subsection Applying Connection Local Variables
+@cindex connection local variables, applying
+
+ When writing connection-aware code, you'll need to collect, and
+possibly apply, any connection-local variables. There are several
+ways to do this, as described below.
+
@defun hack-connection-local-variables criteria
This function collects applicable connection-local variables
associated with @var{criteria} in
@@ -2365,7 +2390,7 @@ Example:
@example
@group
(hack-connection-local-variables
- '(:application 'tramp :protocol "ssh" :machine "localhost"))
+ '(:application tramp :protocol "ssh" :machine "localhost"))
@end group
@group
@@ -2384,9 +2409,9 @@ This function looks for connection-local variables
according to
@var{criteria}, and immediately applies them in the current buffer.
@end defun
-@defmac with-connection-local-variables &rest body
-All connection-local variables, which are specified by
-@code{default-directory}, are applied.
+@defmac with-connection-local-application-variables application &rest body
+Apply all connection-local variables for @code{application}, which are
+specified by @code{default-directory}.
After that, @var{body} is executed, and the connection-local variables
are unwound. Example:
@@ -2394,20 +2419,20 @@ are unwound. Example:
@example
@group
(connection-local-set-profile-variables
- 'remote-perl
- '((perl-command-name . "/usr/local/bin/perl")
+ 'my-remote-perl
+ '((perl-command-name . "/usr/local/bin/perl5")
(perl-command-switch . "-e %s")))
@end group
@group
(connection-local-set-profiles
- '(:application 'tramp :protocol "ssh" :machine "remotehost")
- 'remote-perl)
+ '(:application my-app :protocol "ssh" :machine "remotehost")
+ 'my-remote-perl)
@end group
@group
(let ((default-directory "/ssh:remotehost:/working/dir/"))
- (with-connection-local-variables
+ (with-connection-local-application-variables 'my-app
do something useful))
@end group
@end example
@@ -2416,30 +2441,59 @@ are unwound. Example:
@defvar connection-local-default-application
The default application, a symbol, to be applied in
@code{with-connection-local-variables}. It defaults to @code{tramp},
-but in case you want to overwrite Tramp's settings temporarily, you
-could let-bind it like
+but you can let-bind it to change the application temporarily
+(@pxref{Local Variables}).
+
+This variable must not be changed globally.
+@end defvar
+
+@defmac with-connection-local-variables &rest body
+This is equivalent to
+@code{with-connection-local-application-variables}, but uses
+@code{connection-local-default-application} for the application.
+@end defmac
+
+@defmac setq-connection-local [symbol form]@dots{}
+This macro sets each @var{symbol} connection-locally to the result of
+evaluating the corresponding @var{form}, using the connection-local
+profile specified in @code{connection-local-profile-name-for-setq}; if
+the profile name is @code{nil}, this macro will just set the variables
+normally, as with @code{setq} (@pxref{Setting Variables}).
+
+For example, you can use this macro in combination with
+@code{with-connection-local-variables} or
+@code{with-connection-local-application-variables} to lazily
+initialize connection-local settings:
@example
@group
+(defvar my-app-variable nil)
+
(connection-local-set-profile-variables
- 'my-remote-perl
- '((perl-command-name . "/usr/local/bin/perl5")
- (perl-command-switch . "-e %s")))
-@end group
+ 'my-app-connection-default-profile
+ '((my-app-variable . nil)))
-@group
(connection-local-set-profiles
- '(:application 'my-app :protocol "ssh" :machine "remotehost")
- 'my-remote-perl)
+ '(:application my-app)
+ 'my-app-connection-default-profile)
@end group
@group
-(let ((default-directory "/ssh:remotehost:/working/dir/")
- (connection-local-default-application 'my-app))
- (with-connection-local-variables
- do something useful))
+(defun my-app-get-variable ()
+ (with-connection-local-application-variables 'my-app
+ (or my-app-variable
+ (setq-connection-local my-app-variable
+ do something useful))))
@end group
@end example
+@end defmac
+
+@defvar connection-local-profile-name-for-setq
+The connection-local profile name, a symbol, to use when setting
+variables via @code{setq-connection-local}. This is let-bound in the
+body of @code{with-connection-local-variables}, but you can also
+let-bind it yourself if you'd like to set variables on a different
+profile.
This variable must not be changed globally.
@end defvar
diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi
index ee3b15992b..37884faec7 100644
--- a/doc/lispref/windows.texi
+++ b/doc/lispref/windows.texi
@@ -2624,7 +2624,7 @@ default value is an empty display action, i.e.,
@w{@code{(nil . nil)}}.
The value of this option is an alist mapping conditions to display
actions. Each condition is passed to @code{buffer-match-p}, along
with the buffer name and the @var{action} argument passed to
-@code{display-buffer}. If it returns a non-nil value, then
+@code{display-buffer}. If it returns a non-@code{nil} value, then
@code{display-buffer} uses the corresponding display action to display
the buffer.
@end defopt
@@ -6684,32 +6684,32 @@ time window change functions were run for
@var{window}'s frame. If it
returns @code{nil}, @var{window} has been created after that. If it
returns @code{t}, @var{window} was not shown at that time but has been
restored from a previously saved window configuration afterwards.
-Otherwise, the return value is the buffer shown by @code{window} at
+Otherwise, the return value is the buffer shown by @var{window} at
that time.
@end defun
@defun window-old-pixel-width &optional window
This function returns the total pixel width of @var{window} the
-last time window change functions found @code{window} live on its
-frame. It is zero if @code{window} was created after that.
+last time window change functions found @var{window} live on its
+frame. It is zero if @var{window} was created after that.
@end defun
@defun window-old-pixel-height &optional window
This function returns the total pixel height of @var{window} the last
-time window change functions found @code{window} live on its frame.
-It is zero if @code{window} was created after that.
+time window change functions found @var{window} live on its frame.
+It is zero if @var{window} was created after that.
@end defun
@defun window-old-body-pixel-width &optional window
This function returns the pixel width of @var{window}'s text area the
-last time window change functions found @code{window} live on its
-frame. It is zero if @code{window} was created after that.
+last time window change functions found @var{window} live on its
+frame. It is zero if @var{window} was created after that.
@end defun
@defun window-old-body-pixel-height &optional window
This function returns the pixel height of @var{window}'s text area the
-last time window change functions found @code{window} live on its
-frame. It is zero if @code{window} was created after that.
+last time window change functions found @var{window} live on its
+frame. It is zero if @var{window} was created after that.
@end defun
In order to find out which window or frame was selected the last time
diff --git a/doc/misc/ChangeLog.1 b/doc/misc/ChangeLog.1
index 1ee3c14fb9..1c5e7c1e2f 100644
--- a/doc/misc/ChangeLog.1
+++ b/doc/misc/ChangeLog.1
@@ -1460,7 +1460,7 @@
2013-10-24 Michael Albinus <michael.albinus@gmx.de>
- * ert.texi (Running Tests Interactively): Adapt examle output.
+ * ert.texi (Running Tests Interactively): Adapt example output.
(Tests and Their Environment): Mention skip-unless.
2013-10-23 Glenn Morris <rgm@gnu.org>
@@ -3525,7 +3525,7 @@
2012-01-03 Carsten Dominik <carsten.dominik@gmail.com>
- * org.texi (The clock table): Mention that ACHIVED trees
+ * org.texi (The clock table): Mention that ARCHIVED trees
contribute to the clock table.
2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> (tiny change)
@@ -4420,12 +4420,7 @@
2011-02-05 Era Eriksson <era+tramp@iki.fi> (tiny change)
- * tramp.texi:
- Replace "delimet" with "delimit" globally.
- Replace "explicite" with "explicit" globally.
- Replace "instead of" with "instead" where there was nothing after "of".
- Audit use of comma before interrogative pronoun, "that", or "which".
- Minor word order, spelling, wording changes.
+ * tramp.texi: Minor word order, spelling, wording changes.
2011-02-04 Teodor Zlatanov <tzz@lifelogs.com>
@@ -5868,7 +5863,7 @@
2009-09-02 Carsten Dominik <carsten.dominik@gmail.com>
* org.texi (Effort estimates): Document new effort setting commands.
- (Agenda commands): Document the new keys fro agenda time motion.
+ (Agenda commands): Document the new keys for agenda time motion.
Document entry text mode. Improve documentation of the keys to include
inactive time stamps into the agenda view.
(Feedback): Document the new bug report command.
@@ -10409,7 +10404,7 @@
* sc.texi (Emacs 18 MUAs):
* speedbar.texi (Top):
* url.texi (History):
- Delete duplicate duplicate words.
+ Delete duplicate words.
2005-07-16 Johan Bockgård <bojohan@users.sourceforge.net> (tiny change)
diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in
index 1d881a5fc7..a7dbbbb48f 100644
--- a/doc/misc/Makefile.in
+++ b/doc/misc/Makefile.in
@@ -68,13 +68,13 @@ DOCMISC_W32 = @DOCMISC_W32@
## Info files to build and install on all platforms.
INFO_COMMON = auth autotype bovine calc ccmode cl \
- dbus dired-x ebrowse ede ediff edt eieio \
- emacs-mime epa erc ert eshell eudc efaq eww \
- flymake forms gnus emacs-gnutls htmlfontify idlwave ido info.info \
- mairix-el message mh-e modus-themes newsticker nxml-mode octave-mode \
- org pcl-cvs pgg rcirc remember reftex sasl \
- sc semantic ses sieve smtpmail speedbar srecode todo-mode transient \
- tramp url vhdl-mode vip viper vtable widget wisent woman
+ dbus dired-x ebrowse ede ediff edt efaq eglot eieio \
+ emacs-gnutls emacs-mime epa erc ert eshell eudc eww \
+ flymake forms gnus htmlfontify idlwave ido info.info \
+ mairix-el message mh-e modus-themes newsticker nxml-mode \
+ octave-mode org pcl-cvs pgg rcirc reftex remember sasl \
+ sc semantic ses sieve smtpmail speedbar srecode todo-mode \
+ tramp transient url vhdl-mode vip viper vtable widget wisent woman
## Info files to install on current platform.
INFO_INSTALL = $(INFO_COMMON) $(DOCMISC_W32)
diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi
index 9dc63af6bc..872e5f88f5 100644
--- a/doc/misc/auth.texi
+++ b/doc/misc/auth.texi
@@ -526,6 +526,8 @@ If several entries match, the one matching the most items
(where an
while searching for an entry matching the @code{rms} user on host
@code{gnu.org} and port @code{22}, then the entry
@file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}.
+However, such processing is not applied when the option
+@code{auth-source-pass-extra-parameters} is set to @code{t}.
Users of @code{pass} may also be interested in functionality provided
by other Emacs packages:
@@ -549,6 +551,22 @@ Set this variable to a string that should separate an host
name from a
port in an entry. Defaults to @samp{:}.
@end defvar
+@defvar auth-source-pass-extra-query-keywords
+This expands the selection of available keywords to include
+@code{:max} and @code{:require} and tells more of them to accept a
+list of query parameters as an argument. When searching, it also
+favors the @samp{rms@@gnu.org.gpg} form for usernames over the
+@samp{gnu.org/rms.gpg} form, regardless of whether a @code{:user}
+param was provided.
+
+In general, if you prefer idiosyncrasies traditionally exhibited by
+this backend, such as prioritizing field count in a filename, try
+setting this option to @code{nil}. But, if you experience problems
+predicting the outcome of searches relative to other auth-source
+backends or encounter code expecting to query multiple backends
+uniformly, try flipping it back to @code{t} (the default).
+@end defvar
+
@node Help for developers
@chapter Help for developers
diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi
index 1f12c30b1f..bade04fb95 100644
--- a/doc/misc/cc-mode.texi
+++ b/doc/misc/cc-mode.texi
@@ -580,7 +580,7 @@ you are going to be editing AWK files, @file{README}
describes how to
configure your (X)Emacs so that @ccmode{} will supersede the obsolete
@code{awk-mode.el} which might have been supplied with your (X)Emacs.
@ccmode{} might not work with older versions of Emacs or XEmacs. See
-the @ccmode{} release notes at @uref{http://cc-mode.sourceforge.net}
+the @ccmode{} release notes at @uref{https://cc-mode.sourceforge.net}
for the latest information on Emacs version and package compatibility
(@pxref{Updating CC Mode}).
@@ -2191,7 +2191,7 @@ foo& bar
@defvar c-asymmetry-fontification-flag
@vindex asymmetry-fontification-flag @r{(c-)}
-When @code{c-asymmetry-fontification-flag} is non-nil (which it is by
+When @code{c-asymmetry-fontification-flag} is non-@code{nil} (which it is by
default), code like the above, with white space either before or after
the operator, but not both, is fontified as a declaration. When the
variable is nil, such a construct gets the default face.
@@ -3170,7 +3170,7 @@ E. Jones' Filladapt package@footnote{It's available from
lack a feature that makes it work suboptimally when
@code{c-comment-prefix-regexp} matches the empty string (which it does
by default). A patch for that is available from
-@uref{http://cc-mode.sourceforge.net/,, the CC Mode web site}.},
+@uref{https://cc-mode.sourceforge.net/,, the CC Mode web site}.},
@c 2005/11/22: The above is still believed to be the case.
which handles things like bulleted lists nicely. There's a convenience
function @code{c-setup-filladapt} that tunes the relevant variables in
@@ -7583,7 +7583,7 @@ have old versions of @ccmode{} and so should be upgraded.
Access to the
compatibility, etc.@: are all available on the web site:
@quotation
-@uref{http://cc-mode.sourceforge.net/}
+@uref{https://cc-mode.sourceforge.net/}
@end quotation
@@ -7617,7 +7617,7 @@ the GNU Bug Tracker at @url{https://debbugs.gnu.org},
then sends it on
to @email{bug-cc-mode@@gnu.org}. You can also send reports, other
questions, and suggestions (kudos?@: @t{;-)} to that address. It's a
mailing list which you can join or browse an archive of; see the web site at
-@uref{http://cc-mode.sourceforge.net/} for further details.
+@uref{https://cc-mode.sourceforge.net/} for further details.
@cindex announcement mailing list
If you want to get announcements of new @ccmode{} releases, send the
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index a6747b1096..41499d1953 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -3381,9 +3381,9 @@ true for all elements.
@defun cl-reduce function seq @t{&key :from-end :start :end :initial-value
:key}
This function returns the result of calling @var{function} on the
-first and second element of @var{seq}, then calling @var{function}
+first and second elements of @var{seq}, then calling @var{function}
with that result and the third element of @var{seq}, then with that
-result and the third element of @var{seq}, etc.
+result and the fourth element of @var{seq}, etc.
Here is an example. Suppose @var{function} is @code{*} and @var{seq}
is the list @code{(2 3 4 5)}. The first two elements of the list are
@@ -4051,7 +4051,7 @@ following keywords can be used:
@table @code
@item :read-only
-A non-nil value means the slot should not be @code{setf}-able;
+A non-@code{nil} value means the slot should not be @code{setf}-able;
the slot's value is determined when the object is created and does
not change afterward.
diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi
index c0c2ef93d9..0463d068c2 100644
--- a/doc/misc/ede.texi
+++ b/doc/misc/ede.texi
@@ -1432,7 +1432,7 @@ See @file{ede-proj-obj.el} for examples of the
combination.
@item ede-project-placeholder
@table @asis
@item Children:
-@w{@xref{ede-project}.}
+@xref{ede-project}.
@end table
@end table
@end table
@@ -1515,12 +1515,12 @@ Make sure placeholder @var{THIS} is replaced with the
real thing, and pass throu
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
@item ede-project
@table @asis
@item Children:
-@w{@xref{ede-cpp-root-project},} @w{ede-emacs-project,} @w{ede-linux-project,}
@w{ede-maven-project,} @w{@xref{ede-simple-project},}
@w{@xref{ede-simple-base-project},} @w{@xref{ede-proj-project},}
@w{@xref{project-am-makefile},} @w{@xref{ede-step-project}.}
+@xref{ede-cpp-root-project}, @w{ede-emacs-project,} @w{ede-linux-project,}
@w{ede-maven-project,} @xref{ede-simple-project},
@xref{ede-simple-base-project}, @xref{ede-proj-project},
@xref{project-am-makefile}, @xref{ede-step-project}.
@end table
@end table
@end table
@@ -1801,9 +1801,9 @@ Commit change to local variables in @var{PROJ}.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item ede-cpp-root-project
No children
@@ -1923,9 +1923,9 @@ This knows details about or source tree.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item ede-simple-project
No children
@@ -1953,9 +1953,9 @@ Commit any change to @var{PROJ} to its file.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item ede-simple-base-project
No children
@@ -1983,9 +1983,9 @@ This one project could control a tree of subdirectories.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item ede-proj-project
No children
@@ -2173,9 +2173,9 @@ Commit change to local variables in @var{PROJ}.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item project-am-makefile
No children
@@ -2215,9 +2215,9 @@ buffer being in order to provide a smart default target
type.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-project-placeholder}.}
+@item @xref{ede-project-placeholder}.
@table @code
-@item @w{@xref{ede-project}.}
+@item @xref{ede-project}.
@table @code
@item ede-step-project
No children
@@ -2371,7 +2371,7 @@ Commit change to local variables in @var{PROJ}.
@item ede-target
@table @asis
@item Children:
-@w{ede-cpp-root-target,} @w{ede-emacs-target-c,} @w{ede-emacs-target-el,}
@w{ede-emacs-target-misc,} @w{ede-linux-target-c,} @w{ede-linux-target-misc,}
@w{ede-maven-target-java,} @w{ede-maven-target-c,} @w{ede-maven-target-misc,}
@w{ede-simple-target,} @w{@xref{ede-proj-target},} @w{@xref{project-am-target}.}
+@w{ede-cpp-root-target,} @w{ede-emacs-target-c,} @w{ede-emacs-target-el,}
@w{ede-emacs-target-misc,} @w{ede-linux-target-c,} @w{ede-linux-target-misc,}
@w{ede-maven-target-java,} @w{ede-maven-target-c,} @w{ede-maven-target-misc,}
@w{ede-simple-target,} @xref{ede-proj-target}, @xref{project-am-target}.
@end table
@end table
@end table
@@ -2536,7 +2536,7 @@ Call this when a user finishes customizing @var{TARGET}.
@end deffn
@deffn Method project-edit-file-target :AFTER ot
-Edit the target @var{OT} associated w/ this file.
+Edit the target @var{OT} associated with this file.
@end deffn
@deffn Method ede-documentation :AFTER this
@@ -2577,12 +2577,12 @@ Retrieves the slot @code{menu} from an object of class
@code{ede-target}
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
@item ede-proj-target
@table @asis
@item Children:
-@w{@xref{ede-proj-target-makefile},} @w{ede-proj-target-aux,}
@w{@xref{ede-proj-target-scheme}.}
+@xref{ede-proj-target-makefile}, @w{ede-proj-target-aux,}
@xref{ede-proj-target-scheme}.
@end table
@end table
@end table
@@ -2766,14 +2766,14 @@ sources variable.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
@item ede-proj-target-makefile
@table @asis
@item Children:
-@w{@xref{semantic-ede-proj-target-grammar},}
@w{@xref{ede-proj-target-makefile-objectcode},}
@w{@xref{ede-proj-target-elisp},}
@w{@xref{ede-proj-target-makefile-miscelaneous},}
@w{@xref{ede-proj-target-makefile-info}.}
+@xref{semantic-ede-proj-target-grammar},
@xref{ede-proj-target-makefile-objectcode}, @xref{ede-proj-target-elisp},
@xref{ede-proj-target-makefile-miscelaneous},
@xref{ede-proj-target-makefile-info}.
@end table
@end table
@end table
@@ -2864,11 +2864,11 @@ Use @var{CONFIGURATION} as the current configuration to
query.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
@item semantic-ede-proj-target-grammar
No children
@@ -2918,16 +2918,16 @@ Argument @var{THIS} is the target that should insert
stuff.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
@item ede-proj-target-makefile-objectcode
@table @asis
@item Children:
-@w{@xref{ede-proj-target-makefile-archive},}
@w{@xref{ede-proj-target-makefile-program}.}
+@xref{ede-proj-target-makefile-archive},
@xref{ede-proj-target-makefile-program}.
@end table
@end table
@end table
@@ -2980,13 +2980,13 @@ Argument @var{THIS} is the target to get sources from.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
-@item @w{@xref{ede-proj-target-makefile-objectcode}.}
+@item @xref{ede-proj-target-makefile-objectcode}.
@table @code
@item ede-proj-target-makefile-archive
No children
@@ -3023,18 +3023,18 @@ Makefile.am generator, so use it to add this important
bin program.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
-@item @w{@xref{ede-proj-target-makefile-objectcode}.}
+@item @xref{ede-proj-target-makefile-objectcode}.
@table @code
@item ede-proj-target-makefile-program
@table @asis
@item Children:
-@w{@xref{ede-proj-target-makefile-shared-object}.}
+@xref{ede-proj-target-makefile-shared-object}.
@end table
@end table
@end table
@@ -3102,15 +3102,15 @@ Insert bin_PROGRAMS variables needed by target
@var{THIS}.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
-@item @w{@xref{ede-proj-target-makefile-objectcode}.}
+@item @xref{ede-proj-target-makefile-objectcode}.
@table @code
-@item @w{@xref{ede-proj-target-makefile-program}.}
+@item @xref{ede-proj-target-makefile-program}.
@table @code
@item ede-proj-target-makefile-shared-object
No children
@@ -3162,16 +3162,16 @@ Makefile.am generator, so use it to add this important
bin program.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
@item ede-proj-target-elisp
@table @asis
@item Children:
-@w{@xref{ede-proj-target-elisp-autoloads}.}
+@xref{ede-proj-target-elisp-autoloads}.
@end table
@end table
@end table
@@ -3238,13 +3238,13 @@ is found, such as a @code{-version} variable, or the
standard header.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
-@item @w{@xref{ede-proj-target-elisp}.}
+@item @xref{ede-proj-target-elisp}.
@table @code
@item ede-proj-target-elisp-autoloads
No children
@@ -3353,11 +3353,11 @@ sources variable.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
@item ede-proj-target-makefile-miscelaneous
No children
@@ -3409,11 +3409,11 @@ Return a list of files which @var{THIS} target depends
on.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
-@item @w{@xref{ede-proj-target-makefile}.}
+@item @xref{ede-proj-target-makefile}.
@table @code
@item ede-proj-target-makefile-info
No children
@@ -3495,9 +3495,9 @@ when working in Automake mode.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{ede-proj-target}.}
+@item @xref{ede-proj-target}.
@table @code
@item ede-proj-target-scheme
No children
@@ -3539,12 +3539,12 @@ Tweak the configure file (current buffer) to
accommodate @var{THIS}.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
@item project-am-target
@table @asis
@item Children:
-@w{@xref{project-am-objectcode},} @w{project-am-header,}
@w{@xref{project-am-lisp},} @w{@xref{project-am-texinfo},}
@w{@xref{project-am-man}.}
+@xref{project-am-objectcode}, @w{project-am-header,} @xref{project-am-lisp},
@xref{project-am-texinfo}, @xref{project-am-man}.
@end table
@end table
@end table
@@ -3563,7 +3563,7 @@ Run the current project in the debugger.
@end deffn
@deffn Method project-edit-file-target :AFTER obj
-Edit the target associated w/ this file.
+Edit the target associated with this file.
@end deffn
@node project-am-objectcode
@@ -3577,14 +3577,14 @@ Edit the target associated w/ this file.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item project-am-objectcode
@table @asis
@item Children:
-@w{@xref{project-am-program},} @w{project-am-lib.}
+@xref{project-am-program}, @w{project-am-lib.}
@end table
@end table
@end table
@@ -3622,11 +3622,11 @@ There are no default header files.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
-@item @w{@xref{project-am-objectcode}.}
+@item @xref{project-am-objectcode}.
@table @code
@item project-am-program
No children
@@ -3660,9 +3660,9 @@ Additional LD args.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item @w{project-am-header.}
@table @code
@@ -3693,9 +3693,9 @@ Return the default macro to 'edit' for this object.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item @w{project-am-header.}
@table @code
@@ -3726,9 +3726,9 @@ Return the default macro to 'edit' for this object.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item project-am-lisp
No children
@@ -3756,9 +3756,9 @@ Return the default macro to 'edit' for this object.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item project-am-texinfo
No children
@@ -3808,9 +3808,9 @@ files in the project.
@table @code
@item eieio-speedbar-directory-button
@table @code
-@item @w{@xref{ede-target}.}
+@item @xref{ede-target}.
@table @code
-@item @w{@xref{project-am-target}.}
+@item @xref{project-am-target}.
@table @code
@item project-am-man
No children
@@ -3963,7 +3963,7 @@ compile commands.
@item ede-compilation-program
@table @asis
@item Children:
-@w{@xref{ede-compiler},} @w{@xref{ede-linker}.}
+@xref{ede-compiler}, @xref{ede-linker}.
@end table
@end table
@end table
@@ -4071,12 +4071,12 @@ Tweak the configure file (current buffer) to
accommodate @var{THIS}.
@table @code
@item eieio-instance-inheritor
@table @code
-@item @w{@xref{ede-compilation-program}.}
+@item @xref{ede-compilation-program}.
@table @code
@item ede-compiler
@table @asis
@item Children:
-@w{@xref{ede-object-compiler},} @w{semantic-ede-grammar-compiler-class.}
+@xref{ede-object-compiler}, @w{semantic-ede-grammar-compiler-class.}
@end table
@end table
@@ -4179,9 +4179,9 @@ Return a string based on @var{THIS} representing a make
object variable.
@table @code
@item eieio-instance-inheritor
@table @code
-@item @w{@xref{ede-compilation-program}.}
+@item @xref{ede-compilation-program}.
@table @code
-@item @w{@xref{ede-compiler}.}
+@item @xref{ede-compiler}.
@table @code
@item ede-object-compiler
No children
@@ -4222,7 +4222,7 @@ Insert variables needed by the compiler @var{THIS}.
@table @code
@item eieio-instance-inheritor
@table @code
-@item @w{@xref{ede-compilation-program}.}
+@item @xref{ede-compilation-program}.
@table @code
@item ede-linker
No children
diff --git a/doc/misc/efaq-w32.texi b/doc/misc/efaq-w32.texi
index 46c257e42e..b58f6be758 100644
--- a/doc/misc/efaq-w32.texi
+++ b/doc/misc/efaq-w32.texi
@@ -1744,7 +1744,7 @@ date now, so no concrete pointers are available.
You will need an implementation of TeX for Windows.
A number of implementations are listed on the
-@uref{http://www.tug.org/interest.html#free, TeX Users Group} website.
+@uref{https://www.tug.org/interest.html#free, TeX Users Group} website.
@node Spell check
@section How do I perform spell checks?
@@ -1899,7 +1899,7 @@ Christopher Payne wrote a Visual Studio add-in that makes
Emacs the
default text editor, this has now been taken over by Jeff Paquette.
See the following two URLs for details:
@itemize
-@item @uref{http://sourceforge.net/projects/visemacs/} for the latest version.
+@item @uref{https://sourceforge.net/projects/visemacs/} for the latest version.
@item @uref{http://www.smathers.net/VisEmacs.htm} for notes on usage.
@end itemize
@@ -2039,7 +2039,7 @@ this option is set. (I don't see it on VC++ 4.0.)
@cindex Borland C++, integration with Emacs
Jonathan Arnold has written an
-@uref{http://www.buddydog.org/C++Builder/c++builder.html, EmacsEdit
+@uref{https://www.buddydog.org/C++Builder/c++builder.html, EmacsEdit
``expert''} for interfacing C++ Builder and Emacs.
@node Version control
@@ -2194,7 +2194,7 @@ to port software to Windows.
@cindex image libraries, gnuwin32
@cindex image libraries, development
-@uref{http://gnuwin32.sourceforge.net/}
+@uref{https://gnuwin32.sourceforge.net/}
GnuWin32 provides precompiled native Windows ports of a wide selection
of Free software and libraries. Unfortunately, the ports are
diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi
index 0da397919d..3f5c2bc1a7 100644
--- a/doc/misc/efaq.texi
+++ b/doc/misc/efaq.texi
@@ -2668,7 +2668,7 @@ To disable or change the way backups are made,
@cindex Backup files in a single directory
You can control where Emacs puts backup files by customizing the
variable @code{backup-directory-alist}. This variable's value
-specifies that files whose names match specific patters should have
+specifies that files whose names match specific patterns should have
their backups put in certain directories. A typical use is to add the
element @code{("." . @var{dir})} to force Emacs to put @strong{all}
backup files in the directory @file{dir}.
@@ -3622,13 +3622,13 @@ To build Emacs from source for MS-DOS, see the
instructions in the file
on plain DOS, and also on all versions of MS-Windows from version 3.X
onwards, including Windows XP and Vista. Pre-built binaries may be
available at
-@uref{http://www.delorie.com/pub/djgpp/current/v2gnu/emacs.README}
+@uref{https://www.delorie.com/pub/djgpp/current/v2gnu/emacs.README}
For a list of other implementations of Emacs (and Emacs
look-alikes), consult the list of ``Emacs implementations and literature,''
available at
-@uref{http://www.finseth.com/emacs.html}
+@uref{https://www.finseth.com/emacs.html}
Note that while many of these programs look similar to Emacs, they often
lack certain features, such as the Emacs Lisp extension language.
@@ -3757,7 +3757,7 @@ Various spell-checkers are compatible with Emacs,
including:
@table @b
@item Hunspell
-@uref{http://hunspell.sourceforge.net/}
+@uref{https://hunspell.github.io/}
@item GNU Aspell
@uref{http://aspell.net/}
diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi
new file mode 100644
index 0000000000..04bdcc6161
--- /dev/null
+++ b/doc/misc/eglot.texi
@@ -0,0 +1,1160 @@
+\input texinfo @c -*-texinfo-*-
+@c %**start of header
+@setfilename ../../eglot.info
+@settitle Eglot: The Emacs Client for the Language Server Protocol
+@include docstyle.texi
+@syncodeindex vr cp
+@syncodeindex fn cp
+@c %**end of header
+
+@copying
+This manual is for Eglot, the Emacs LSP client.
+
+Copyright @copyright{} 2022 Free Software Foundation, Inc.
+
+@quotation
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3 or
+any later version published by the Free Software Foundation; with no
+Invariant Sections, with the Front-Cover Texts being ``A GNU Manual'',
+and with the Back-Cover Texts as in (a) below. A copy of the license
+is included in the section entitled ``GNU Free Documentation License''.
+
+(a) The FSF's Back-Cover Text is: ``You have the freedom to copy and
+modify this GNU manual.''
+@end quotation
+@end copying
+
+@dircategory Emacs misc features
+@direntry
+* Eglot: (eglot). Language Server Protocol client for Emacs.
+@end direntry
+
+@titlepage
+@sp 4
+@c The title is printed in a large font.
+@center @titlefont{User's Guide}
+@sp 1
+@center @titlefont{to}
+@sp 1
+@center @titlefont{Eglot: The Emacs LSP Client}
+@ignore
+@sp 2
+@center release 1.8
+@c -release-
+@end ignore
+@sp 3
+@center Jo@~ao T@'avora & Eli Zaretskii
+@c -date-
+
+@page
+@vskip 0pt plus 1filll
+@insertcopying
+@end titlepage
+
+@contents
+
+@ifnottex
+@node Top
+@top Eglot
+
+@cindex LSP
+@cindex language server protocol
+Eglot is the Emacs client for the @dfn{Language Server Protocol}
+(@acronym{LSP}). The name ``Eglot'' is an acronym that stands for
+@ifhtml
+``@emph{E}macs Poly@emph{glot}''.
+@end ifhtml
+@ifnothtml
+``Emacs polyGLOT''.
+@end ifnothtml
+@footnote{
+A @dfn{polyglot} is a
+person who is able to use several languages.
+} Eglot provides infrastructure and a set of commands for enriching
+the source code editing capabilities of Emacs via LSP@. LSP is a
+standardized communications protocol between source code editors (such
+as Emacs) and language servers---programs external to Emacs which
+analyze the source code on behalf of Emacs. The protocol allows Emacs
+to receive various source code services from the server, such as
+description and location of function calls, types of variables, class
+definitions, syntactic errors, etc. This way, Emacs doesn't need to
+implement the language-specific parsing and analysis capabilities in
+its own code, but is still capable of providing sophisticated editing
+features that rely on such capabilities, such as automatic code
+completion, go-to definition of function/class, documentation of
+symbol at-point, refactoring, on-the-fly diagnostics, and more.
+
+Eglot itself is completely language-agnostic, but it can support any
+programming language for which there is a language server and an Emacs
+major mode.
+
+This manual documents how to configure, use, and customize Eglot.
+
+@insertcopying
+
+@menu
+* Quick Start:: For the impatient.
+* Eglot and LSP Servers:: How to work with language servers.
+* Using Eglot:: Important Eglot commands and variables.
+* Customizing Eglot:: Eglot customization and advanced features.
+* Troubleshooting Eglot:: Troubleshooting and reporting bugs.
+* GNU Free Documentation License:: The license for this manual.
+* Index::
+@end menu
+@end ifnottex
+
+@node Quick Start
+@chapter Quick Start
+@cindex quick start
+
+This chapter provides concise instructions for setting up and using
+Eglot with your programming project in common usage scenarios. For
+more detailed instructions regarding Eglot setup, @pxref{Eglot and LSP
+Servers}. @xref{Using Eglot}, for detailed description of using Eglot,
+and see @ref{Customizing Eglot}, for adapting Eglot to less common use
+patterns.
+
+Here's how to start using Eglot with your programming project:
+
+@enumerate
+@item
+Select and install a language server.
+
+Eglot comes pre-configured with many popular language servers, see the
+value of @code{eglot-server-programs}. If the server(s) mentioned
+there satisfy your needs for the programming language(s) with which
+you want to use Eglot, you just need to make sure those servers are
+installed on your system. Alternatively, install one or more servers
+of your choice and add them to the value of
+@code{eglot-server-programs}, as described in @ref{Setting Up LSP
+Servers}.
+
+@item
+Turn on Eglot for your project.
+
+To start using Eglot for a project, type @kbd{M-x eglot @key{RET}} in
+a buffer visiting any file that belongs to the project. This starts
+the language server configured for the programming language of that
+buffer, and causes Eglot to start managing all the files of the
+project which use the same programming language. The notion of a
+``project'' used by Eglot is the same Emacs uses (@pxref{Projects,,,
+emacs, GNU Emacs Manual}): in the simplest case, the ``project'' is
+the single file you are editing, but it can also be all the files in a
+single directory or a directory tree under some version control
+system, such as Git.
+
+Alternatively, you can start Eglot automatically from the major-mode
+hook of the mode used for the programming language; see @ref{Starting
+Eglot}.
+
+@item
+Use Eglot.
+
+Most Eglot facilities are integrated into Emacs features, such as
+ElDoc, Flymake, Xref, and Imenu. However, Eglot also provides
+commands of its own, mainly to perform tasks by the LSP server, such
+as @kbd{M-x eglot-rename} (to rename an identifier across the entire
+project), @kbd{M-x eglot-format} (to reformat and reindent code), and
+some others. @xref{Eglot Commands}, for the detailed list of Eglot
+commands.
+
+@item
+That's it!
+@end enumerate
+
+@node Eglot and LSP Servers
+@chapter Eglot and LSP Servers
+
+This chapter describes how to set up Eglot for your needs, and how to
+start it.
+
+@menu
+* Setting Up LSP Servers:: How to configure LSP servers for your needs.
+* Starting Eglot:: Ways of starting Eglot for your project.
+* Shutting Down LSP Servers::
+@end menu
+
+@node Setting Up LSP Servers
+@section Setting Up LSP Servers
+@cindex setting up LSP server for Eglot
+@cindex language server for Eglot
+
+For Eglot to be useful, it must first be combined with a suitable
+language server. Usually, that means running the server program
+locally as a child process of Emacs (@pxref{Processes,,, elisp, GNU
+Emacs Lisp Reference Manual}) and communicating with it via the
+standard input and output streams.
+
+The language server program must be installed separately, and is not
+further discussed in this manual; refer to the documentation of the
+particular server(s) you want to install.
+
+To use a language server, Eglot must know how to start it and which
+programming languages each server supports. This information is
+provided by the variable @code{eglot-server-programs}.
+
+@defvar eglot-server-programs
+This variable associates major modes with names and command-line
+arguments of the language server programs corresponding to the
+programming language of each major mode. It provides all the
+information that Eglot needs to know about the programming language of
+the source you are editing.
+
+The value of the variable is an alist, whose elements are of the form
+@w{@code{(@var{major-mode} . @var{server})}}.
+
+The @var{major-mode} of the alist elements can be either a symbol of
+an Emacs major mode or a list of the form @w{@code{(@var{mode}
+:language-id @var{id})}}, with @var{mode} being a major-mode symbol
+and @var{id} a string that identifies the language to the server (if
+Eglot cannot by itself convert the major-mode to the language
+identifier string required by the server). In addition,
+@var{major-mode} can be a list of several major modes specified in one
+of the above forms -- this means a running instance of the associated
+server is responsible for files of multiple major modes or languages
+in the project.
+
+The @var{server} part of the alist elements can be one of the
+following:
+
+@table @code
+@item (@var{program} @var{args}@dots{})
+This says to invoke @var{program} with zero or more arguments
+@var{args}; the program is expected to communicate with Emacs via the
+standard input and standard output streams.
+
+@item (@var{program} @var{args}@dots{} :initializationOptions
@var{options}@dots{})
+Like above, but with @var{options} specifying the options to be
+used for constructing the @samp{initializationOptions} JSON object for
+the server. @var{options} can also be a function of one argument, in
+which case it will be called with the server instance as the argument,
+and should return the JSON object to use for initialization.
+
+@item (@var{host} @var{port} @var{args}@dots{})
+Here @var{host} is a string and @var{port} is a positive integer
+specifying a TCP connection to a remote server. The @var{args} are
+passed to @code{open-network-stream}, e.g.@: if the connection needs
+to use encryption or other non-default parameters (@pxref{Network,,,
+elisp, GNU Emacs Lisp Reference Manual}).
+
+@item (@var{program} @var{args}@dots{} :autoport @var{moreargs}@dots{})
+@var{program} is started with a command line constructed from
+@var{args} followed by an available server port and the rest of
+arguments in @var{moreargs}; Eglot then establishes a TCP connection
+with the server via that port on the local host.
+
+@item @var{function}
+This should be a function of a single argument: non-@code{nil} if the
+connection was requested interactively (e.g., by the @code{eglot}
+command), otherwise @code{nil}. The function should return a value of
+any of the forms described above. This allows interaction with the
+user for determining the program to start and its command-line
+arguments.
+@end table
+
+@end defvar
+
+Eglot comes with a fairly complete set of associations of major-modes
+to popular language servers predefined. If you need to add server
+associations to the default list, use @code{add-to-list}. For
+example, if there is a hypothetical language server program
+@command{fools} for the language @code{Foo} which is supported by an
+Emacs major-mode @code{foo-mode}, you can add it to the alist like
+this:
+
+@lisp
+(with-eval-after-load 'eglot
+ (add-to-list 'eglot-server-programs
+ '(foo-mode . ("fools" "--stdio"))))
+@end lisp
+
+This will invoke the program @command{fools} with the command-line
+argument @option{--stdio} in support of editing source files for which
+Emacs turns on @code{foo-mode}, and will communicate with the program
+via the standard streams. As usual with invoking programs, the
+executable file @file{fools} should be in one of the directories
+mentioned by the @code{exec-path} variable (@pxref{Subprocess
+Creation,,, elisp, GNU Emacs Lisp Reference Manual}), for Eglot to be
+able to find it.
+
+Sometimes, multiple servers are acceptable alternatives for handling a
+given major-mode. In those cases, you may combine the helper function
+@code{eglot-alternatives} with the funcional form of
+@code{eglot-server-programs}.
+
+@lisp
+(with-eval-after-load 'eglot
+ (add-to-list 'eglot-server-programs
+ `(foo-mode . ,(eglot-alternatives
+ '(("fools" "--stdio")
+ ("phewls" "--fast"))))))
+@end lisp
+
+If you have @command{fools} and @command{phewls} installed, the
+function produced by @code{eglot-alternatives} will prompt for the
+server to use in @code{foo-mode} buffers. Else it will use whichever
+is available.
+
+@node Starting Eglot
+@section Starting Eglot
+@cindex starting Eglot
+@cindex activating Eglot for a project
+
+@findex eglot
+The most common way to start Eglot is to simply visit a source file of
+a given language and use the command @kbd{M-x eglot}. This starts the
+language server suitable for the visited file's major-mode, and
+attempts to connect to it. If the connection to the language server
+is successful, you will see the @code{[eglot:@var{project}]} indicator
+on the mode line which reflects the server that was started. If the
+server program couldn't be started or connection to it failed, you
+will see an error message; in that case, try to troubleshoot the
+problem as described in @ref{Troubleshooting Eglot}. Once a language
+server was successfully started and Eglot connected to it, you can
+immediately start using the Emacs features supported by Eglot, as
+described in @ref{Eglot Features}.
+
+A single Eglot session for a certain major-mode usually serves all the
+buffers under that mode which visit files from the same project, so
+you don't need to invoke @kbd{M-x eglot} again when you visit another
+file from the same project which is edited using the same major-mode.
+This is because Eglot uses the Emacs project infrastructure, as
+described in @ref{Eglot and Buffers}, and this knows about files that
+belong to the same project. Thus, after starting an Eglot session for
+some buffer, that session is automatically reused when visiting files
+in the same project with the same major-mode.
+
+@findex eglot-ensure
+Alternatively, you could configure Eglot to start automatically for
+one or more major-modes from the respective mode hooks. Here's an
+example for a hypothetical @code{foo-mode}:
+
+@lisp
+ (add-hook 'foo-mode-hook 'eglot-ensure)
+@end lisp
+
+@noindent
+The function @code{eglot-ensure} will start an Eglot session for each
+buffer in which @code{foo-mode} is turned on, if there isn't already
+an Eglot session that handles the buffer. Note that this variant of
+starting an Eglot session is non-interactive, so it should be used
+only when you are confident that Eglot can be started reliably for any
+file which may be visited with the major-mode in question.
+
+When Eglot connects to a language server for the first time in an
+Emacs session, it runs the hook @code{eglot-connect-hook}
+(@pxref{Eglot Variables}).
+
+@node Shutting Down LSP Servers
+@section Shutting Down LSP Servers
+@cindex shutting down LSP server
+
+When Eglot is turned on, it arranges for turning itself off
+automatically if the language server process terminates. Turning off
+Eglot means that it shuts down the server connection, ceases its
+management of all the buffers that use the server connection which was
+terminated, deactivates its minor mode, and restores the original
+values of the Emacs variables that Eglot changed when it was turned
+on. @xref{Eglot and Buffers}, for more details of what Eglot
+management of a buffer entails.
+
+@findex eglot-shutdown
+You can also shut down a language server manually, by using the
+command @kbd{M-x eglot-shutdown}. This prompts for the server (unless
+there's only one connection and it's used in the current buffer), and
+then shuts it down. By default, it also kills the server's events
+buffer (@pxref{Troubleshooting Eglot}), but a prefix argument prevents
+that.
+
+Alternatively, you can customize the variable
+@code{eglot-autoshutdown} to a non-@code{nil} value, in which case
+Eglot will automatically shut down the language server process when
+the last buffer served by that language server is killed. The default
+of this variable is @code{nil}, so that visiting another file would
+automatically activate Eglot even when the project which started Eglot
+with the server no longer has any buffer associated with it. This
+default allows you to start a server only once in each Emacs session.
+
+@node Using Eglot
+@chapter Using Eglot
+
+This chapter describes in detail the features that Eglot provides and
+how it does that. It also provides reference sections for Eglot
+commands and variables.
+
+@menu
+* Eglot Features::
+* Eglot and Buffers::
+* Eglot Commands::
+* Eglot Variables::
+@end menu
+
+@node Eglot Features
+@section Eglot Features
+@cindex features in buffers supported by Eglot
+
+Once Eglot is enabled in a buffer, it uses LSP and the language-server
+capabilities to activate, enable, and enhance modern IDE features in
+Emacs. The features themselves are usually provided via other Emacs
+packages. Here's the list of the main features that Eglot enables and
+provides:
+
+@itemize @bullet
+@item
+At-point documentation: when point is at or near a symbol or an
+identifier, the information about the symbol/identifier, such as the
+signature of a function or class method and server-generated
+diagnostics, is made available via the ElDoc package (@pxref{Lisp
+Doc,,, emacs, GNU Emacs Manual}). This allows major modes to provide
+extensive help and documentation about the program identifiers.
+
+@item
+On-the-fly diagnostic annotations with server-suggested fixes, via the
+Flymake package (@pxref{Top,,, flymake, GNU Flymake manual}). This
+improves and enhances the Flymake diagnostics, replacing the other
+Flymake backends.
+
+@item
+Finding definitions and uses of identifiers, via Xref (@pxref{Xref,,,
+emacs, GNU Emacs Manual}). Eglot provides a backend for the Xref
+capabilities which uses the language-server understanding of the
+program source. In particular, it eliminates the need to generate
+tags tables (@pxref{Tags tables,,, emacs, GNU Emacs Manual}) for
+languages which are only supported by the @code{etags} backend.
+
+@item
+Buffer navigation by name of function, class, method, etc., via Imenu
+(@pxref{Imenu,,, emacs, GNU Emacs Manual}). Eglot provides its own
+variant of @code{imenu-create-index-function}, which generates the
+index for the buffer based on language-server program source analysis.
+
+@item
+Enhanced completion of symbol at point by the
+@code{completion-at-point} command (@pxref{Symbol Completion,,, emacs,
+GNU Emacs Manual}). This uses the language-server's parser data for
+the completion candidates.
+
+@item
+Automatic reformatting of source code as you type it. This is similar
+to what the @code{eglot-format} command does (see below), but is
+activated automatically as you type.
+
+@item
+If a completion package such as @code{company-mode}, a popular
+third-party completion package (or any other completion package), is
+installed, Eglot enhances it by providing completion candidates based
+on the language-server analysis of the source code.
+(@code{company-mode} can be installed from GNU ELPA.)
+
+@item
+If @code{yasnippet}, a popular third-party package for automatic
+insertion of code templates (snippets), is installed, and the language
+server supports snippet completion candidates, Eglot arranges for the
+completion package to instantiate these snippets using
+@code{yasnippet}. (@code{yasnippet} can be installed from GNU ELPA.)
+
+@item
+If the popular third-party package @code{markdown-mode} is installed,
+and the server provides at-point documentation formatted as Markdown
+in addition to plain text, Eglot arranges for the ElDoc package to
+enrich this text with fontifications and other nice formatting before
+displaying it to the user. This makes the documentation shown by
+ElDoc look nicer on display.
+
+@item
+In addition to enabling and enhancing other features and packages,
+Eglot also provides a small number of user commands based directly on
+the capabilities of language servers. These commands are:
+
+@table @kbd
+@item M-x eglot-rename
+This prompts for a new name for the symbol at point, and then modifies
+all the project source files to rename the symbol to the new name,
+based on editing data received from the language-server. @xref{Eglot
+and Buffers}, for the details of how project files are defined.
+
+@item M-x eglot-format
+This reformats and prettifies the current active region according to
+source formatting rules of the language-server. If the region is not
+active, it reformats the entire buffer instead.
+
+@item M-x eglot-format-buffer
+This reformats and prettifies the current buffer according to source
+formatting rules of the language-server.
+
+@cindex code actions
+@item M-x eglot-code-actions
+@itemx M-x eglot-code-action-organize-imports
+@itemx M-x eglot-code-action-quickfix
+@itemx M-x eglot-code-action-extract
+@itemx M-x eglot-code-action-inline
+@itemx M-x eglot-code-action-rewrite
+These command allow you to invoke the so-called @dfn{code actions}:
+requests for the language-server to provide editing commands for
+various code fixes, typically either to fix an error diagnostic or to
+beautify/refactor code. For example,
+@code{eglot-code-action-organize-imports} rearranges the program
+@dfn{imports}---declarations of modules whose capabilities the program
+uses. These commands affect all the files that belong to the
+project. The command @kbd{M-x eglot-code-actions} will pop up a menu
+of code applicable actions at point.
+@end table
+
+@end itemize
+
+Not all servers support the full set of LSP capabilities, but most of
+them support enough to enable the basic set of features mentioned
+above. Conversely, some servers offer capabilities for which no
+equivalent Emacs package exists yet, and so Eglot cannot (yet) expose
+these capabilities to Emacs users.
+
+@node Eglot and Buffers
+@section Buffers, Projects, and Eglot
+@cindex buffers managed by Eglot
+@cindex projects and Eglot
+
+@cindex workspace
+One of the main strong points of using a language server is that a
+language server has a broad view of the program: it considers more
+than just the single source file you are editing. Ideally, the
+language server should know about all the source files of your program
+which are written in the language supported by the server. In the
+language-server parlance, the set of the source files of a program is
+known as a @dfn{workspace}. The Emacs equivalent of a workspace is a
+@dfn{project} (@pxref{Projects,,, emacs, GNU Emacs Manual}). Eglot
+fully supports Emacs projects, and considers the file in whose buffer
+Eglot is turned on as belonging to a project. In the simplest case,
+that file is the entire project, i.e.@: your project consists of a
+single file. But there are other more complex projects:
+
+@itemize @bullet
+@item
+A single-directory project: several source files in a single common
+directory.
+
+@item
+A VC project: source files in a directory hierarchy under some VCS,
+e.g.@: a VCS repository (@pxref{Version Control,,, emacs, GNU Emacs
+Manual}).
+
+@item
+An EDE project: source files in a directory hierarchy managed via the
+Emacs Development Environment (@pxref{EDE,,, emacs, GNU Emacs
+Manual}).
+@end itemize
+
+Eglot uses Emacs's project management infrastructure to figure out
+which files and buffers belong to what project, so any kind of project
+supported by that infrastructure is automatically supported by Eglot.
+
+When Eglot starts a server program, it does so in the project's root
+directory, which is usually the top-level directory of the project's
+directory hierarchy. This ensures the language server has the same
+comprehensive view of the project's files as you do.
+
+For example, if you visit the file @file{~/projects/fooey/lib/x.foo}
+and @file{x.foo} belongs to a project rooted at
+@file{~/projects/fooey} (perhaps because a @file{.git} directory
+exists there), then @kbd{M-x eglot} causes the server program to start
+with that root as the current working directory. The server then will
+analyze not only the file @file{lib/x.foo} you visited, but likely
+also all the other @file{*.foo} files under the
+@file{~/projects/fooey} directory.
+
+In some cases, additional information specific to a given project will
+need to be provided to the language server when starting it. The
+variable @code{eglot-workspace-configuration} (@pxref{Customizing
+Eglot}) exists for that purpose. It specifies the parameters and
+their values to communicate to each language server which needs that.
+
+When Eglot is active for a project, it performs several background
+activities on behalf of the project and its buffers:
+
+@itemize @bullet
+@cindex mode-line indication of language server
+@cindex mouse clicks on mode-line, and Eglot
+@vindex eglot-menu
+@item
+All of the project's file-visiting buffers under the same major-mode
+are served by a single language-server connection. (If the project
+uses several programming languages, there will usually be a separate
+server connection for each group of files written in the same language
+and using the same Emacs major-mode.) Eglot adds the
+@samp{[eglot:@var{project}]} indication to the mode line of
+each such buffer, where @var{server} is the name of the server and
+@var{project} identifies the project by its root directory. Clicking
+the mouse on the Eglot mode-line indication activates a menu with
+server-specific items.
+
+@item
+For each buffer in which Eglot is active, it notifies the language
+server that Eglot is @dfn{managing} the file visited by that buffer.
+This tells the language server that the file's contents on disk may no
+longer be up-to-date due to unsaved edits. Eglot reports to the
+server any changes in the text of each managed buffer, to make the
+server aware of unsaved changes. This includes your editing of the
+buffer and also changes done automatically by other Emacs features and
+commands. Killing a buffer relinquishes its management by Eglot and
+notifies the server that the file on disk is up-to-date.
+
+@vindex eglot-managed-mode-hook
+@vindex eglot-managed-p
+@item
+Eglot turns on a special minor mode in each buffer it manages. This
+minor mode ensures the server is notified about files Eglot manages,
+and also arranges for other Emacs features supported by Eglot
+(@pxref{Eglot Features}) to receive information from the language
+server, by changing the settings of these features. Unlike other
+minor-modes, this special minor mode is not activated manually by the
+user, but automatically, as the result of starting an Eglot session
+for the buffer. However, this minor mode provides a hook variable
+@code{eglot-managed-mode-hook} that can be used to customize the Eglot
+management of the buffer. This hook is run both when the minor mode
+is turned on and when it's turned off; use the variable
+@code{eglot-managed-p} to tell if current buffer is still being
+managed or not. When Eglot stops managing the buffer, this minor mode
+is turned off, and all the settings that Eglot changed are restored to
+their original values.
+
+@item
+When you visit a file under the same project, whether an existing or a
+new file, its buffer is automatically added to the set of buffers
+managed by Eglot, and the server which supports the buffer's
+major-mode is notified about that. Thus, visiting a non-existent file
+@file{/home/joe/projects/fooey/lib/y.foo} in the above example will
+notify the server of the @file{*.foo} files' language that a new file
+was added to the project, even before the file appears on disk. The
+special Eglot minor mode is also turned on automatically in the buffer
+visiting the file.
+@end itemize
+
+@node Eglot Commands
+@section Eglot Commands
+@cindex commands, Eglot
+
+This section provides a reference for the most commonly used Eglot
+commands:
+
+@ftable @code
+@item M-x eglot
+This command adds the current buffer and the file it visits to the
+group of buffers and files managed by Eglot on behalf of a suitable
+language server. If a language server for the buffer's
+@code{major-mode} (@pxref{Major Modes,,, emacs, GNU Emacs Manual}) is
+not yet running, it will be started; otherwise the buffer and its file
+will be added to those managed by an existing server session.
+
+The command attempts to figure out the buffer's major mode and the
+suitable language server; in case it fails, it might prompt for the
+major mode to use and for the server program to start. If invoked
+with @kbd{C-u}, it always prompts for the server program, and if
+invoked with @kbd{C-u C-u}, it also prompts for the major mode.
+
+If the language server is successfully started and contacted, this
+command arranges for any other buffers belonging to the same project
+and using the same major mode to use the same language-server session.
+That includes any buffers created by visiting files after this command
+succeeds to connect to a language server.
+
+All the Emacs features that are capable of using Eglot services
+(@pxref{Eglot Features}) are automatically configured by this command
+to start using the language server via Eglot. To customize which
+Emacs features will be configured to use Eglot, use the
+@code{eglot-stay-out-of} option (@pxref{Customizing Eglot}).
+
+@item M-x eglot-reconnect
+This command shuts down the current connection to the language
+server and immediately restarts it using the same options used
+originally. This can sometimes be useful to unclog a partially
+malfunctioning server connection.
+
+@item M-x eglot-shutdown
+This command shuts down a language server. It prompts for a language
+server to shut down (unless there's only one server session, and it
+manages the current buffer). Then the command shuts down the server
+and stops managing the buffers the server was used for. Emacs
+features (@pxref{Eglot Features}) that Eglot configured to work with
+the language server are restored back to their original configuration.
+
+Normally, this command kills the buffers used for communicating with
+the language server, but if invoked with a prefix argument @kbd{C-u},
+the command doesn't kill those buffers, allowing them to be used for
+diagnostics and problem reporting (@pxref{Troubleshooting Eglot}).
+
+@item M-x eglot-shutdown-all
+This command shuts down all the language servers active in the current
+Emacs session. As with @code{eglot-shutdown}, invoking this command
+with a prefix argument avoids killing the buffers used for
+communications with the language servers.
+
+@item M-x eglot-rename
+This command renames the program symbol (a.k.a.@: @dfn{identifier}) at
+point to another name. It prompts for the new name of the symbol, and
+then modifies all the files in the project which are managed by the
+language server of the current buffer to implement the renaming.
+
+@item M-x eglot-format
+This command reformats the active region according to the
+language-server rules. If no region is active, it reformats the
+entire current buffer.
+
+@item M-x eglot-format-buffer
+This command reformats the current buffer, in the same manner as
+@code{eglot-format} does.
+
+@item M-x eglot-code-actions
+@itemx mouse-1
+This command asks the server for any @dfn{code actions} applicable at
+point. It can also be invoked by @kbd{mouse-1} clicking on
+diagnostics provided by the server.
+
+@item M-x eglot-code-action-organize-imports
+@itemx M-x eglot-code-action-quickfix
+@itemx M-x eglot-code-action-extract
+@itemx M-x eglot-code-action-inline
+@itemx M-x eglot-code-action-rewrite
+These commands invoke specific code actions supported by the language
+server.
+@c FIXME: Need more detailed description of each action.
+@end ftable
+
+The following Eglot commands are used less commonly, mostly for
+diagnostic and troubleshooting purposes:
+
+@ftable @code
+@item M-x eglot-events-buffer
+This command pops up the events buffer used for communication with the
+language server of the current buffer.
+
+@item M-x eglot-stderr-buffer
+This command pops up the buffer with the debug info printed by the
+language server to its standard error stream.
+
+@item M-x eglot-forget-pending-continuations
+Forget pending requests for the server of the current buffer.
+@c FIXME: Better description of the need.
+
+@item M-x eglot-signal-didChangeConfiguration
+This command updates the language server configuration according to
+the current value of the variable @code{eglot-workspace-configuration}
+(@pxref{Customizing Eglot}).
+
+@item M-x eglot-clear-status
+Clear the last JSONRPC error for the server of the current buffer.
+Eglot keeps track of erroneous situations encountered by the server in
+its mode-line indication so that the user may inspect the
+communication leading up to it (@pxref{Troubleshooting Eglot}). If
+the situation is deemed uninteresting or temporary, this command can
+be used to ``forget'' the error. Note that the command @code{M-x
+eglot-reconnect} can sometimes be used to unclog a temporarily
+malfunctioning server.
+@end ftable
+
+As described in @ref{Eglot Features} most features associated with
+Eglot are actually provided by other Emacs packages and features, and
+Eglot only enhances them by allowing them to use the information
+coming from the language servers. For completeness, here's the list
+of commands of those other packages that are very commonly used in
+Eglot-managed buffers:
+
+@c Not @ftable, because the index entries should mention Eglot
+@table @code
+@cindex eldoc, and Eglot
+@cindex documentation using Eglot
+@item M-x eldoc
+Ask the ElDoc system for help at point.
+
+@cindex flymake, and Eglot
+@cindex on-the-fly diagnostics using Eglot
+@item M-x flymake-show-buffer-diagnostics
+Ask Flymake system to display diagnostics for the current buffer.
+
+@item M-x flymake-show-project-diagnostics
+Ask Flymake to list diagnostics for all the files in the current
+project.
+
+@cindex xref, and Eglot
+@cindex finding definitions of identifiers using Eglot
+@item M-x xref-find-definitions
+Ask Xref to go the definition of the identifier at point.
+
+@cindex imenu navigation using Eglot
+@item M-x imenu
+Let the user navigate the program source code using buffer index,
+categorizing program elements by syntactic class (class, method,
+variable, etc.) and offering completion.
+
+@cindex symbol completion using Eglot
+@item M-x completion-at-point
+Request completion of the symbol at point.
+@end table
+
+@node Eglot Variables
+@section Eglot Variables
+@cindex variables, Eglot
+
+This section provides a reference for the Eglot user options.
+
+@vtable @code
+@item eglot-autoreconnect
+This option controls the ability to reconnect automatically to the
+language server when Eglot detects that the server process terminated
+unexpectedly. The default value @code{3} means to attempt reconnection only
+if the previous successful connection lasted for more than that number
+of seconds; a different positive value changes the minimal length of
+the connection to trigger reconnection. A value of @code{t} means
+always reconnect automatically, and @code{nil} means never reconnect
+(in which case you will need to reconnect manually using @kbd{M-x
+eglot}).
+
+@item eglot-connect-timeout
+This specifies the number of seconds before connection attempt to a
+language server times out. The value of @code{nil} means never time
+out. The default is 30 seconds.
+
+@item eglot-sync-connect
+This setting is mainly important for connections which are slow to
+establish. Whereas the variable @code{eglot-connect-timeout} controls
+how long to wait for, this variable controls whether to block Emacs's
+user interface while waiting. The default value is @code{3}; a positive
+value means block for that many seconds, then wait for the connection
+in the background. The value of @code{t} means block during the whole
+waiting period. The value of @code{nil} or @code{0} means don't block at
+all during the waiting period.
+
+@item eglot-events-buffer-size
+This determines the size of the Eglot events buffer. @xref{Eglot
+Commands, eglot-events-buffer}, for how to display that buffer. If
+the value is changed, for it to take effect the connection should be
+restarted using @kbd{M-x eglot-reconnect}.
+@c FIXME: Shouldn't the defcustom do this by itself using the :set
+@c attribute?
+@xref{Troubleshooting Eglot}, for when this could be useful.
+
+@item eglot-autoshutdown
+If this is non-@code{nil}, Eglot shuts down a language server when the
+last buffer managed by it is killed. @xref{Shutting Down LSP Servers}.
+The default is @code{nil}; if you want to shut down a server, use
+@kbd{M-x eglot-shutdown} (@pxref{Eglot Commands}).
+
+@item eglot-confirm-server-initiated-edits
+Various Eglot commands and code actions result in the language server
+sending editing commands to Emacs. If this option's value is
+non-@code{nil} (the default), Eglot will ask for confirmation before
+performing edits initiated by the server or edits whose scope affects
+buffers other than the one where the user initiated the request.
+
+@item eglot-ignored-server-capabilities
+This variable's value is a list of language server capabilities that
+Eglot should not use. The default is @code{nil}: Eglot uses all of
+the capabilities supported by each server.
+
+@item eglot-extend-to-xref
+If this is non-@code{nil}, and @kbd{M-.}
+(@code{xref-find-definitions}) lands you in a file outside of your
+project, such as a system-installed library or header file,
+transiently consider that file as managed by the same language server.
+That file is still outside your project (i.e. @code{project-find-file}
+won't find it), but Eglot and the server will consider it to be part
+of the workspace. The default is @code{nil}.
+
+@item eglot-mode-map
+This variable is the keymap for binding Eglot-related command. It is
+in effect only as long as the buffer is managed by Eglot. By default,
+it is empty, with the single exception: @kbd{C-h .} is remapped to
+invoke @code{eldoc-doc-buffer}. You can bind additional commands in
+this map. For example:
+
+@lisp
+ (define-key eglot-mode-map (kbd "C-c r") 'eglot-rename)
+ (define-key eglot-mode-map (kbd "C-c o") 'eglot-code-action-organize-imports)
+ (define-key eglot-mode-map (kbd "C-c h") 'eldoc)
+ (define-key eglot-mode-map (kbd "<f6>") 'xref-find-definitions)
+@end lisp
+
+@end vtable
+
+Additional variables, which are relevant for customizing the server
+connections, are documented in @ref{Customizing Eglot}.
+
+@node Customizing Eglot
+@chapter Customizing Eglot
+@cindex customizing Eglot
+
+Eglot itself has a relatively small number of customization options.
+A large part of customizing Eglot to your needs and preferences should
+actually be done via options of the Emacs packages and features which
+Eglot supports and enhances (@pxref{Eglot Features}). For example:
+
+@itemize @bullet
+@item
+To configure the face used for server-derived errors and warnings,
+customize the Flymake faces @code{flymake-error} and
+@code{flymake-warning}.
+
+@item
+To configure the amount of space taken up by documentation in the
+echo area, customize the ElDoc variable
+@code{eldoc-echo-area-use-multiline-p}.
+
+@item
+To completely change how ElDoc displays the at-point documentation
+destination, customize the ElDoc variable
+@code{eldoc-display-functions}.
+@end itemize
+
+For this reason, this manual describes only how to customize
+Eglot's own operation, which mainly has to do with the server
+connections and the server features to be used by Eglot.
+
+@c @table, not @vtable, because some of the variables are indexed
+@c elsewhere
+@table @code
+@item eglot-server-programs
+This variable determines which language server to start for each
+supported major mode, and how to invoke that server's program.
+@xref{Setting Up LSP Servers}, for the details.
+
+@vindex eglot-strict-mode
+@item eglot-strict-mode
+This is @code{nil} by default, meaning that Eglot is generally lenient
+about non-conforming servers. If you need to debug a server, set this
+to @w{@code{(disallow-non-standard-keys enforce-required-keys)}}.
+
+@vindex eglot-server-initialized-hook
+@item eglot-server-initialized-hook
+A hook run after the server object is successfully initialized.
+
+@vindex eglot-connect-hook
+@item eglot-connect-hook
+A hook run after connection to the server is successfully
+established. @xref{Starting Eglot}.
+
+@item eglot-managed-mode-hook
+A hook run after Eglot started or stopped managing a buffer.
+@xref{Eglot and Buffers}, for details of its usage.
+
+@vindex eglot-stay-out-of
+@item eglot-stay-out-of
+This variable's value lists Emacs features that Eglot shouldn't
+automatically try to manage on the user's behalf. It is useful, for
+example, when you need to use non-LSP Flymake or Company back-ends.
+To have Eglot stay away from some Emacs feature, add that feature's
+symbol or a regexp that will match a symbol's name to the list: for
+example, the symbol @code{xref} to leave Xref alone, or the string
+@samp{company} to stay away from your Company customizations. Here's an
+example:
+
+@lisp
+(add-to-list 'eglot-stay-out-of 'flymake)
+@end lisp
+
+Note that you can still configure the excluded Emacs features manually
+to use Eglot in your @code{eglot-managed-mode-hook} or via some other
+mechanism.
+
+@vindex eglot-workspace-configuration
+@cindex server workspace configuration
+@item eglot-workspace-configuration
+This variable is meant to be set in the @file{.dir-locals.el} file, to
+provide per-project settings, as described below in more detail.
+@end table
+
+Some language servers need to know project-specific settings, which
+the LSP calls @dfn{workspace configuration}. Eglot allows such fine
+tuning of per-project settings via the variable
+@code{eglot-workspace-configuration}. Eglot sends the settings in
+this variable to each server, and each server applies the portion of the
+settings relevant to it and ignores the rest. These settings are
+communicated to the server initially (upon establishing the
+connection) or when the settings are changed, or in response to a
+configuration request from the server.
+
+In many cases, servers can be configured globally using a
+configuration file in the user's home directory or in the project
+directory, which the language server reads. For example, the
+@command{pylsp} server for Python reads the file
+@file{~/.config/pycodestyle} and the @command{clangd} server reads the
+file @file{.clangd} anywhere in the current project's directory tree.
+If possible, we recommend using those configuration files that are
+independent of Eglot and Emacs; they have the advantage that they will
+work with other LSP clients as well.
+
+If you do need to provide Emacs-specific configuration for a language
+server, we recommend defining the appropriate value in the
+@file{.dir-locals.el} file in the project's directory. The value of
+this variable should be a property list of the following format:
+
+@lisp
+ (:@var{server} @var{plist}@dots{})
+@end lisp
+
+@noindent
+Here @code{:@var{server}} identifies a particular language server and
+@var{plist} is the corresponding keyword-value property list of one or
+more parameter settings for that server, serialized by Eglot as a JSON
+object. @var{plist} may be arbitrarity complex, generally containing
+other keywork-value property sublists corresponding to JSON subobjects.
+The JSON values @code{true}, @code{false}, @code{null} and @code{@{@}}
+are represented by the Lisp values @code{t}, @code{:json-false},
+@code{nil}, and @code{eglot-@{@}}, respectively.
+
+@findex eglot-show-workspace-configuration
+When experimenting with workspace settings, you can use the command
+@kbd{M-x eglot-show-workspace-configuration} to inspect and debug the
+JSON value to be sent to the server. This helper command works even
+before actually connecting to the server.
+
+Here's an example of defining the workspace-configuration settings for
+a project that uses two different language servers, one for Python,
+the other one for Go (presumably, the project is written in a
+combination of these two languages). The server for Python in this
+case is @command{pylsp}, the server for Go is @command{gopls}. The
+value of @code{eglot-workspace-configuration} in this case should be:
+
+@lisp
+((python-mode
+ . ((eglot-workspace-configuration
+ . (:pylsp (:plugins (:jedi_completion (:include_params t
+ :fuzzy t)
+ :pylint (:enabled :json-false)))))))
+ (go-mode
+ . ((eglot-workspace-configuration
+ . (:gopls (:usePlaceholders t))))))
+@end lisp
+
+@noindent
+This should go into the @file{.dir-locals.el} file in the project's
+root directory. It sets up the value of
+@code{eglot-workspace-configuration} separately for each major mode.
+
+Alternatively, the same configuration could be defined as follows:
+
+@lisp
+((nil
+ . ((eglot-workspace-configuration
+ . (:pylsp (:plugins (:jedi_completion (:include_params t
+ :fuzzy t)
+ :pylint (:enabled :json-false)))
+ :gopls (:usePlaceholders t))))))
+@end lisp
+
+This is an equivalent setup which sets the value for all the
+major-modes inside the project; each server will use only the section
+of the parameters intended for that server, and ignore the rest.
+
+As yet another alternative, you can set the value of
+@code{eglot-workspace-configuration} programmatically, via the
+@code{dir-locals-set-class-variables} function, @pxref{Directory Local
+Variables,,, elisp, GNU Emacs Lisp Reference Manual}.
+
+Finally, if one needs to determine the workspace configuration based
+on some dynamic context, @code{eglot-workspace-configuration} can be
+set to a function. The function is called with the
+@code{eglot-lsp-server} instance of the connected server (if any) and
+with @code{default-directory} set to the root of the project. The
+function should return a value of the form described above.
+
+Some servers need special hand-holding to operate correctly. If your
+server has some quirks or non-conformity, it's possible to extend
+Eglot via Elisp to adapt to it, by defining a suitable
+@code{eglot-initialization-options} method via @code{cl-defmethod}
+(@pxref{Generic Functions,,, elisp, GNU Emacs Lisp Reference Manual}).
+
+Here's an example:
+
+@lisp
+(require 'eglot)
+
+(add-to-list 'eglot-server-programs
+ '((c++-mode c-mode) . (eglot-cquery "cquery")))
+
+(defclass eglot-cquery (eglot-lsp-server) ()
+ :documentation "A custom class for cquery's C/C++ langserver.")
+
+(cl-defmethod eglot-initialization-options ((server eglot-cquery))
+ "Passes through required cquery initialization options"
+ (let* ((root (car (project-roots (eglot--project server))))
+ (cache (expand-file-name ".cquery_cached_index/" root)))
+ (list :cacheDirectory (file-name-as-directory cache)
+ :progressReportFrequencyMs -1)))
+@end lisp
+
+@noindent
+See the doc string of @code{eglot-initialization-options} for more
+details.
+@c FIXME: The doc string of eglot-initialization-options should be
+@c enhanced and extended.
+
+@node Troubleshooting Eglot
+@chapter Troubleshooting Eglot
+@cindex troubleshooting Eglot
+
+This section documents commands and variables that can be used to
+troubleshoot Eglot problems. It also provides guidelines for
+reporting Eglot bugs in a way that facilitates their resolution.
+
+When you encounter problems with Eglot, try first using the commands
+@kbd{M-x eglot-events-server} and @kbd{M-x eglot-stderr-buffer}. They
+pop up special buffers that can be used to inspect the communications
+between the Eglot and language server. In many cases, this will
+indicate the problems or at least provide a hint.
+
+A common and easy-to-fix cause of performance problems is the length
+of these two buffers. If Eglot is operating correctly but slowly,
+customize the variable @code{eglot-events-buffer-size} (@pxref{Eglot
+Variables}) to limit logging, and thus speed things up.
+
+If you need to report an Eglot bug, please keep in mind that, because
+there are so many variables involved, it is generally both very
+@emph{difficult} and @emph{absolutely essential} to reproduce bugs
+exactly as they happened to you, the user. Therefore, every bug
+report should include:
+
+@enumerate
+@item
+The transcript of events obtained from the buffer popped up by
+@kbd{M-x eglot-events-buffer}. If the transcript can be narrowed down
+to show the problematic exchange, so much the better. This is
+invaluable for the investigation and reproduction of the problem.
+
+@item
+If Emacs signaled an error (an error message was seen or heard), make
+sure to repeat the process after toggling @code{debug-on-error} on
+(via @kbd{M-x toggle-debug-on-error}). This normally produces a
+backtrace of the error that should also be attached to the bug report.
+
+@item
+An explanation of how to obtain, install, and configure the language
+server you used. If possible, try to replicate the problem with the
+C/C@t{++} or Python servers, as these are very easy to install.
+
+@item
+A description of how to setup the @emph{minimal} project (one or two
+files and their contents) where the problem happens.
+
+@item
+A recipe to replicate the problem with @emph{a clean Emacs run}. This
+means @kbd{emacs -Q} invocation or a very minimal (no more that 10
+lines) @file{.emacs} initialization file. @code{eglot-ensure} and
+@code{use-package} calls are generally @emph{not} needed.
+
+@item
+Make sure to double check all the above elements and re-run the
+recipe to see that the problem is reproducible.
+@end enumerate
+
+Please keep in mind that some problems reported against Eglot may
+actually be bugs in the language server or the Emacs feature/package
+that used Eglot to communicate with the language server.
+
+@node GNU Free Documentation License
+@appendix GNU Free Documentation License
+@include doclicense.texi
+
+@node Index
+@unnumbered Index
+@printindex cp
+
+@bye
diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 3db83197f9..0d807e323e 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -79,6 +79,7 @@ Advanced Usage
* Connecting:: Ways of connecting to an IRC server.
* Sample Configuration:: An example configuration file.
+* Integrations:: Integrations available for ERC.
* Options:: Options that are available for ERC.
@end detailmenu
@@ -526,6 +527,7 @@ Translate morse code in messages
@menu
* Connecting:: Ways of connecting to an IRC server.
* Sample Configuration:: An example configuration file.
+* Integrations:: Integrations available for ERC.
* Options:: Options that are available for ERC.
@end menu
@@ -861,7 +863,8 @@ The default value for all three options is the function
@code{erc-auth-source-search}. It tries to merge relevant contextual
parameters with those provided or discovered from the logical connection
or the underlying transport. Some auth-source back ends may not be
-compatible; netrc, plstore, json, and secrets are currently supported.
+compatible; netrc, plstore, json, secrets, and pass are currently
+supported.
@end defopt
@subheading Full name
@@ -990,6 +993,32 @@ stuff, to the current ERC buffer."
;; (setq erc-kill-server-buffer-on-quit t)
@end lisp
+@node Integrations
+@section Integrations
+@cindex integrations
+
+@subheading URL
+For anything to work, you'll want to set @code{url-irc-function} to
+@code{url-irc-erc}. As a rule of thumb, libraries relying directly on
+@code{url-retrieve} should be fine out the box from Emacs 29.1 onward.
+On older versions of Emacs, you may need to @code{(require 'erc)}
+beforehand. @pxref{Retrieving URLs,,, url, URL}.
+
+For other apps and libraries, such as those relying on the
+higher-level @code{browse-url}, you'll oftentimes be asked to specify
+a pattern, sometimes paired with a function that accepts a string URL
+as a first argument. For example, with EWW, you may need to tack
+something like @code{"\\|\\`irc6?s?:"} onto the end of
+@code{eww-use-browse-url}. But with @code{gnus-button-alist}, you'll
+need a function as well:
+
+@lisp
+ '("\\birc6?s?://[][a-z0-9.,@@_:+%?&/#-]+" 0 t browse-url-irc 0)
+@end lisp
+
+@noindent
+Users on Emacs 28 and below may need to use @code{browse-url} instead.
+
@node Options
@section Options
@cindex options
diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi
index 0ee33f2c2a..e6ddcf11df 100644
--- a/doc/misc/eshell.texi
+++ b/doc/misc/eshell.texi
@@ -439,11 +439,6 @@ Print the current local time as a human-readable string.
This command
is similar to, but slightly different from, the GNU Coreutils
@command{date} command.
-@item define
-@cmindex define
-Define a variable alias.
-@xref{Variable Aliases, , , elisp, The Emacs Lisp Reference Manual}.
-
@item diff
@cmindex diff
Compare files using Emacs's internal @code{diff} (not to be confused
@@ -699,10 +694,18 @@ used for comparing lists of strings.
This command can be loaded as part of the eshell-xtra module, which is
disabled by default.
+@item set
+@cmindex set
+Set variable values, using the function @code{set} like a command
+(@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}).
+A variable name can be a symbol, in which case it refers to a Lisp
+variable, or a string, referring to an environment variable
+(@pxref{Arguments}).
+
@item setq
@cmindex setq
-Set variable values, using the function @code{setq} like a command.
-@xref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}.
+Set variable values, using the function @code{setq} like a command
+(@pxref{Setting Variables,,, elisp, GNU Emacs Lisp Reference Manual}).
@item source
@cmindex source
@@ -714,9 +717,12 @@ current environment.
@cmindex su
@itemx sudo
@cmindex sudo
-Uses TRAMP's @command{su} or @command{sudo} method @pxref{Inline methods, , ,
tramp}
-to run a command via @command{su} or @command{sudo}. These commands
-are in the eshell-tramp module, which is disabled by default.
+@itemx doas
+@cmindex doas
+Uses TRAMP's @command{su}, @command{sudo}, or @command{doas} method
+@pxref{Inline methods, , , tramp} to run a command via @command{su},
+@command{sudo}, or @command{doas}. These commands are in the
+eshell-tramp module, which is disabled by default.
@item substitute
@@ -748,7 +754,9 @@ disabled by default.
@item unset
@cmindex unset
-Unset an environment variable.
+Unset one or more variables. As with @command{set}, a variable name
+can be a symbol, in which case it refers to a Lisp variable, or a
+string, referring to an environment variable.
@item wait
@cmindex wait
@@ -795,12 +803,12 @@ command-line switch:
@table @var
@item short
-This element, if non-nil, should be a character to be used as a short
+This element, if non-@code{nil}, should be a character to be used as a short
switch, like @code{-@var{short}}. At least one of this element and
-@var{long} must be non-nil.
+@var{long} must be non-@code{nil}.
@item long
-This element, if non-nil, should be a string to be used as a long
+This element, if non-@code{nil}, should be a string to be used as a long
switch, like @code{--@var{long}}.
@item value
@@ -886,12 +894,35 @@ For example, you could handle a subset of the options for
the
@node Variables
@section Variables
-Since Eshell is just an Emacs @acronym{REPL}@footnote{
+@vindex eshell-prefer-lisp-variables
+Since Eshell is a combination of an Emacs @acronym{REPL}@footnote{
Short for ``Read-Eval-Print Loop''.
-}
-, it does not have its own scope, and simply stores variables the same
-you would in an Elisp program. Eshell provides a command version of
-@code{setq} for convenience.
+} and a command shell, it can refer to variables from two different
+sources: ordinary Emacs Lisp variables, as well as environment
+variables. By default, when using a variable in Eshell, it will first
+look in the list of built-in variables, then in the list of
+environment variables, and finally in the list of Lisp variables. If
+you would prefer to use Lisp variables over environment variables, you
+can set @code{eshell-prefer-lisp-variables} to @code{t}.
+
+You can set variables in a few different ways. To set a Lisp
+variable, you can use the command @samp{setq @var{name} @var{value}},
+which works much like its Lisp counterpart (@pxref{Setting Variables,
+, , elisp, The Emacs Lisp Reference Manual}). To set an environment
+variable, use @samp{export @var{name}=@var{value}}. You can also use
+@samp{set @var{variable} @var{value}}, which sets a Lisp variable if
+@var{variable} is a symbol, or an environment variable if it's a
+string (@pxref{Arguments}). Finally, you can temporarily set
+environment variables for a single command with
+@samp{@var{name}=@var{value} @var{command} @dots{}}. This is
+equivalent to:
+
+@example
+@{
+ export @var{name}=@var{value}
+ @var{command} @dots{}
+@}
+@end example
@subsection Built-in variables
Eshell knows a few built-in variables:
@@ -914,6 +945,16 @@ When using @code{$-}, you can also access older
directories in the
directory ring via subscripting, e.g.@: @samp{$-[1]} refers to the
working directory @emph{before} the previous one.
+@vindex $PATH
+@item $PATH
+This specifies the directories to search for executable programs. Its
+value is a string, separated by @code{":"} for Unix and GNU systems,
+and @code{";"} for MS systems. This variable is connection-aware, so
+whenever you change the current directory to a different host
+(@pxref{Remote Files, , , emacs, The GNU Emacs Manual}),
+the value will automatically update to reflect the search path on that
+host.
+
@vindex $_
@item $_
This refers to the last argument of the last command. With a
@@ -1085,7 +1126,7 @@ Repeatedly evaluate @var{commands} until
@var{conditional} is
satisfied.
@item for @var{var} in @var{list}@dots{} @{ @var{commands} @}
-Iterate over each element of of @var{list}, storing the element in
+Iterate over each element of @var{list}, storing the element in
@var{var} and evaluating @var{commands}. If @var{list} is not a list,
treat it as a list of one element. If you specify multiple
@var{lists}, this will iterate over each of them in turn.
@@ -1138,7 +1179,7 @@ a number if possible.
@item one or both (non-@code{nil}) lists
Concatenate ``adjacent'' elements of each value (possibly converting
-back to a number as above). For example, @samp{$list("a" "b")c}
+back to a number as above). For example, @samp{$(list "a" "b")c}
returns @samp{("a" "bc")}.
@item anything else
diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi
index 0037ba78d3..0e1ff67c1f 100644
--- a/doc/misc/eudc.texi
+++ b/doc/misc/eudc.texi
@@ -85,6 +85,10 @@ LDAP, Lightweight Directory Access Protocol
BBDB, Big Brother's Insidious Database
@item
macOS Contacts
+@item
+@code{ecomplete}, Emacs's electrical completion
+@item
+@code{mailabbrev}, Emacs's abbrev-expansion of mail aliases
@end itemize
The main features of the EUDC interface are:
@@ -110,6 +114,8 @@ Interface to BBDB to let you insert server records into
your own BBDB database
* LDAP:: What is LDAP ?
* BBDB:: What is BBDB ?
* macOS Contacts:: What is macOS Contacts ?
+* ecomplete:: What is @code{ecomplete} ?
+* mailabbrev:: What is @code{mailabbrev}?
@end menu
@@ -173,14 +179,73 @@ Address Book; the EUDC macOS Contacts back end also works
on those
older versions.
+@node ecomplete
+@section @code{ecomplete}
+
+@code{ecomplete} is Emacs's ``electric completion'', and it is part of
+Emacs. It stores all information in an @file{ecompleterc} file, whose
+location, and name can be configured via the variable
+@code{ecomplete-database-file} (which see). The format of the file
+is:
+
+@display
+((TYPE_1 ITEM_1 ITEM_2 ...)
+ (TYPE_2 ITEM_N+1 ITEM_N+2 ...)
+ ...)
+@end display
+
+That is, it is an alist map where the key is the type of match (so
+that you can have one list of things for ``mail'', and one for, say,
+``mastodon''). In each of these sections you then have a list where
+each item is of the form:
+
+@display
+(KEY TIMES-USED LAST-TIME-USED STRING)
+@end display
+
+When performing a query, the result will be all items where the search
+term matches all, or part of STRING.
+
+When EUDC performs queries with @code{ecomplete}, the name of each
+attribute making up the query is used as the type in which the lookup
+is performed. The mapping from EUDC attribute names to
+@code{ecomplete} type names is performed according to the variable
+@code{eudc-ecomplete-attributes-translation-alist} (which see).
+
+
+@node mailabbrev
+@section @code{mailabbrev}
+
+@code{mailabbrev} is Emacs's ``abbrev-expansion of mail aliases'', and
+it is part of Emacs. It stores all information in a @file{mailrc}
+file, whose location, and name can be configured via the variable
+@code{mail-personal-alias-file} (which see). The @file{mailrc} file
+has the same format as the @command{mail} and @command{mailx} commands
+use for their startup configuration file. @code{mailabbrev} processes
+@samp{alias}, and @samp{source} statements in the @file{mailrc} file.
+@samp{alias} statements can define simple aliases and distribution
+lists, and can be nested in that the alias expansion can contain
+references to other alias definitions. Forward references, that is
+references to aliases before they are actually defined, are possible,
+too.
+
+Originally, @code{mailabbrev} was designed to be used with
+@code{abbrev-mode}. The @code{mailabbrev} EUDC backend does not use
+@code{abbrev-mode}, but queries @code{mailabbrev} for alias entries
+only, and returns these as EUDC results. All entries where the alias
+name exactly equals either the @code{email}, @code{name}, or
+@code{firstname} attribute value in the EUDC query, will be returned
+as matches. When a @file{mailrc} alias defines a distribution list,
+that is it expands to more than one email address, the EUDC result
+will contain a single entry, which will contain an email attribute
+only, whose value will be a comma-separated list of RFC 5322 formatted
+recipient specifications.
+
+
@node Installation
@chapter Installation
-Add the following to your @file{.emacs} init file:
-@lisp
-(require 'eudc)
-@end lisp
-This will install EUDC at startup.
+EUDC is built-in to Emacs, and its main functions are autoloaded.
After installing EUDC you will find (the next time you launch Emacs) a
new @code{Directory Search} submenu in the @samp{Tools} menu that will
@@ -200,6 +265,8 @@ email composition buffers (@pxref{Inline Query Expansion})
@menu
* LDAP Configuration:: EUDC needs external support for LDAP
* macOS Contacts Configuration:: Enable the macOS Contacts backend
+* ecomplete Configuration:: Enable the ecomplete backend
+* mailabbrev Configuration:: Enable the mailabbrev backend
@end menu
@node LDAP Configuration
@@ -256,7 +323,7 @@ will return all LDAP entries with surnames that begin with
@code{Smith}. In every LDAP query it makes, EUDC implicitly appends
the wildcard character to the end of the last word, except if the word
corresponds to an attribute which is a member of
-`eudc-ldap-no-wildcard-attributes'.
+@code{eudc-ldap-no-wildcard-attributes}.
@menu
* Emacs-only Configuration:: Configure with @file{.emacs}
@@ -406,9 +473,9 @@ level to 5 by appending @code{-d 5} to the command line.
macOS Contacts support is added by means of @file{eudcb-mab.el}, or
@file{eudcb-macos-contacts.el} which are part of Emacs.
-To enable a macOS Contacts backend, first `require' the respective
-library to load it, and then set the `eudc-server' to localhost in
-your init file:
+To enable a macOS Contacts backend, first @code{require} the
+respective library to load it, and then set the @code{eudc-server} to
+localhost in your init file:
@lisp
(require 'eudcb-macos-contacts)
(eudc-macos-contacts-set-server "localhost")
@@ -433,6 +500,32 @@ command-line utility before upgrading to a new version of
macOS.
existing configurations, and may be removed in a future release.
+@node ecomplete Configuration
+@section @code{ecomplete} Configuration
+
+@code{ecomplete} is Emacs's ``electrical completion'', and is part of
+Emacs. To use it, you will need to set up a database file
+(@pxref{ecomplete}) first.
+
+It will be autoloaded on demand.
+
+You can also enable multi-server queries as described in
+@pxref{Multi-server Queries}.
+
+
+@node mailabbrev Configuration
+@section @code{mailabbrev} Configuration
+
+@code{mailabbrev} is Emacs's ``abbrev-expansion of mail aliases'', and
+it is part of Emacs. To use it, you will need to set up a database file
+(@pxref{mailabbrev}) first.
+
+It will be autoloaded on demand.
+
+You can also enable multi-server queries as described in
+@pxref{Multi-server Queries}.
+
+
@node Usage
@chapter Usage
@@ -916,13 +1009,23 @@ in other places, like for example the body of the
message.
@section The Server Hotlist
EUDC lets you maintain a list of frequently used servers so that you
-can easily switch from one to another. This hotlist appears in the
-@samp{Server} submenu. You select a server in this list by clicking on
-its name. You can add the current server to the list with the command
-@kbd{M-x eudc-bookmark-current-server}. The list is contained in the variable
-@code{eudc-server-hotlist} which is stored in and retrieved from the file
-designated by @code{eudc-options-file}. EUDC also provides a facility to
-edit the hotlist interactively (@pxref{The Hotlist Edit Buffer}).
+can easily switch from one to another. Most users should configure
+the hotlist via Customize, and store the configuration in the main
+Emacs initialization file. Configuring it dynamically can be
+confusing, particularly if the hotlist settings are saved to
+@code{eudc-options-file} automatically. @code{eudc-options-file} is
+historical and support for it is still maintained, but new EUDC users
+should set @code{eudc-ignore-options-file} to @code{t}.
+
+However, this hotlist also appears in the @samp{Server} submenu. You
+select a server in this list by clicking on its name. You can add the
+current server to the list with the command @kbd{M-x
+eudc-bookmark-current-server}. The list is contained in the variable
+@code{eudc-server-hotlist} which is stored in and retrieved from the
+file designated by @code{eudc-options-file}, or normal Emacs
+initialization if @code{eudc-ignore-options-file} is non-nil. EUDC
+also provides a facility to edit the hotlist interactively (@pxref{The
+Hotlist Edit Buffer}).
The hotlist is also used to make queries on multiple servers
successively (@pxref{Multi-server Queries}). The order in which the
@@ -937,6 +1040,14 @@ Add @var{server} to the hotlist of servers
Add the current server to the hotlist of servers
@end deffn
+@defvar eudc-ignore-options-file
+If non-nil, then EUDC ignores @code{eudc-options-file} and warns or
+issues an error when an attempt is made to use it. Most users should
+set this, and keep their EUDC configuration in the main Emacs
+initialization file instead. The separate eudc-options file has
+created confusion for users in the past.
+@end defvar
+
@defvar eudc-options-file
The name of a file where EUDC stores its internal variables (the
hotlist and the current server). EUDC will try to load that file upon
diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi
index 7406557623..4561b760c0 100644
--- a/doc/misc/flymake.texi
+++ b/doc/misc/flymake.texi
@@ -312,7 +312,7 @@ been reported.
Which fringe (if any) should show the warning/error bitmaps.
@item flymake-wrap-around
-If non-nil, moving to errors with @code{flymake-goto-next-error} and
+If non-@code{nil}, moving to errors with @code{flymake-goto-next-error} and
@code{flymake-goto-prev-error} wraps around buffer boundaries.
@end vtable
@@ -615,7 +615,7 @@ delimited by @var{beg} and @var{end}. @var{type} is a
diagnostic
symbol (@pxref{Flymake error types}), and @var{text} is a description
of the problem detected in this region. Most commonly @var{locus} is
the buffer object designating for the current buffer being
-syntax-checked. However, it may be a string nameing a file relative
+syntax-checked. However, it may be a string naming a file relative
to the current working directory. @xref{Foreign and list-only
diagnostics}, for when this may be useful. Depending on the type of
@var{locus}, @var{beg} and @var{end} are both either buffer positions
@@ -844,8 +844,8 @@ Binding,,, elisp, The Emacs Lisp Reference Manual}) to be
active.
* Interaction with other modes::
@end menu
-@findex flymake-proc-legacy-backend
-The backend @code{flymake-proc-legacy-backend} was originally designed
+@findex flymake-proc-legacy-flymake
+The backend @code{flymake-proc-legacy-flymake} was originally designed
to be extended for supporting new syntax check tools and error message
patterns. It is also controlled by its own set of customization variables
@@ -878,7 +878,7 @@ line-idx col-idx err-text-idx)}. @xref{Parsing the output}.
@item flymake-proc-diagnostic-type-pred
A function to classify a diagnostic text as particular type of error.
Should be a function taking an error text and returning a diagnostic
-symbol (@pxref{Flymake error types}). If non-nil is returned but
+symbol (@pxref{Flymake error types}). If non-@code{nil} is returned but
there is no such symbol in that table, a warning is assumed. If nil
is returned, an error is assumed. Can also be a regular expression
that should match only warnings. This variable replaces the old
@@ -1053,7 +1053,7 @@ check-syntax:
@cindex syntax check models
@cindex master file
-@code{flymake-proc-legacy-backend} saves a copy of the buffer in a
+@code{flymake-proc-legacy-flymake} saves a copy of the buffer in a
temporary file in the buffer's directory (or in the system temporary
directory, for Java files), creates a syntax check command and
launches a process with this command. The output is parsed using a
diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi
index 3aad985c5a..7cb5621b69 100644
--- a/doc/misc/gnus-faq.texi
+++ b/doc/misc/gnus-faq.texi
@@ -1330,7 +1330,7 @@ details.
However, what you really want is the Insidious Big Brother
Database bbdb. Get it from
-@uref{http://bbdb.sourceforge.net/, bbdb's website}.
+@uref{https://bbdb.sourceforge.net/, bbdb's website}.
Now place the following in @file{~/.gnus.el}, to activate bbdb for Gnus:
@example
@@ -1782,13 +1782,13 @@ when you're online.
Let's talk about Unix systems first: For the news part,
the easiest solution is a small nntp server like
@uref{https://www.leafnode.org/, Leafnode} or
-@uref{http://patrik.iki.fi/sn/, sn},
+@uref{https://patrik.iki.fi/sn/, sn},
of course you can also install a full featured news
server like
@uref{https://www.isc.org/othersoftware/, inn}.
Then you want to fetch your Mail, popular choices
are @uref{https://www.fetchmail.info/, fetchmail}
-and @uref{http://pyropus.ca/software/getmail/, getmail}.
+and @uref{https://pyropus.ca/software/getmail/, getmail}.
You should tell those to write the mail to your disk and
Gnus to read it from there. Last but not least the mail
sending part: This can be done with every MTA like
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index b1331e79bf..c4705928d3 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -8045,7 +8045,7 @@ to a string containing the default command and options
(default
@findex gnus-summary-muttprint
@vindex gnus-summary-muttprint-program
Save the current article into muttprint. That is, print it using the
-external program @uref{http://muttprint.sourceforge.net/,
+external program @uref{https://muttprint.sourceforge.net/,
Muttprint}. The program name and options to use is controlled by the
variable @code{gnus-summary-muttprint-program}.
(@code{gnus-summary-muttprint}).
@@ -9343,7 +9343,7 @@ Use Gnus rendered based on w3m.
Use @uref{http://emacs-w3m.namazu.org/, emacs-w3m}.
@item w3m-standalone
-Use @uref{http://w3m.sourceforge.net/, w3m}.
+Use @uref{https://w3m.sourceforge.net/, w3m}.
@item links
Use @uref{http://links.twibright.com/, Links}.
@@ -10497,7 +10497,7 @@ normally, but it'll make this command work a whole lot
faster. Of
course, it'll make group entry somewhat slow.
@vindex gnus-refer-thread-use-search
-If @code{gnus-refer-thread-use-search} is non-nil then those backends
+If @code{gnus-refer-thread-use-search} is non-@code{nil} then those backends
that know how to find threads directly will search not just in the
current group but all groups on the same server.
@@ -10515,7 +10515,7 @@ is true and the initial referral starts from a summary
buffer for a
non-virtual group this may not be possible. In this case a new
summary buffer is created holding a virtual group with the result of
the thread search.) If @code{gnus-refer-thread-limit-to-thread} is
-non-nil then the summary buffer will be limited to articles in the
+non-@code{nil} then the summary buffer will be limited to articles in the
thread.
@item M-^ (Summary)
@@ -13602,7 +13602,7 @@ Here's the method for a public spool:
If you are behind a firewall and only have access to the @acronym{NNTP}
server from the firewall machine, you can instruct Gnus to @code{rlogin}
on the firewall machine and connect with
-@uref{http://netcat.sourceforge.net/, netcat} from there to the
+@uref{https://netcat.sourceforge.net/, netcat} from there to the
@acronym{NNTP} server.
Doing this can be rather fiddly, but your virtual server definition
should probably look something like this:
@@ -21569,7 +21569,7 @@ Search Groups}).
Search queries can be specified one of two ways: either using the
syntax of the engine responsible for the group you're searching, or
using Gnus' generalized search syntax. Set the option
-@code{gnus-search-use-parsed-queries} to a non-nil value to used the
+@code{gnus-search-use-parsed-queries} to a non-@code{nil} value to used the
generalized syntax. The advantage of this syntax is that, if you have
multiple backends indexed by different engines, you don't need to
remember which one you're searching---it's also possible to issue the
@@ -21592,11 +21592,10 @@ details on Gnus' query language, see @ref{Search
Queries}.
In order to search for messages from any given server, that server
must have a search engine associated with it. IMAP servers do their
-own searching (theoretically it is possible to use a different engine
-to search an IMAP store, but we don't recommend it), but in all other
-cases the user will have to manually specify an engine to use. This
-can be done at two different levels: by server type, or on a
-per-server basis.
+own searching, and searching IMAP groups will work with no additional
+configuration, but in all other cases the user will have to manually
+specify an engine to use. This can be done at two different levels:
+by server type, or on a per-server basis.
@vindex gnus-search-default-engines
The option @code{gnus-search-default-engines} assigns search engines
@@ -21900,14 +21899,13 @@ be found at
@uref{http://www.rpcurnow.force9.co.uk/mairix/index.html}
Though mairix might not be as flexible as other search tools like
-swish++ or namazu, which you can use via the @code{nnir} back end, it
-has the prime advantage of being incredibly fast. On current systems, it
-can easily search through headers and message bodies of thousands and
-thousands of mails in well under a second. Building the database
-necessary for searching might take a minute or two, but only has to be
-done once fully. Afterwards, the updates are done incrementally and
-therefore are really fast, too. Additionally, mairix is very easy to set
-up.
+swish++ or namazu, it has the prime advantage of being incredibly
+fast. On current systems, it can easily search through headers and
+message bodies of thousands and thousands of mails in well under a
+second. Building the database necessary for searching might take a
+minute or two, but only has to be done once fully. Afterwards, the
+updates are done incrementally and therefore are really fast, too.
+Additionally, mairix is very easy to set up.
For maximum speed though, mairix should be used with mails stored in
@code{Maildir} or @code{MH} format (this includes the @code{nnml} back
@@ -22545,6 +22543,21 @@ to you, using @kbd{G b u} and updating the group will
usually fix this.
@end itemize
+@node nnir
+@section Migrating from nnir
+
+@cindex nnir
+
+Gnus' previous search engine was called nnir, and is obsolete as of
+Emacs version 28. If you've upgraded Emacs and are now getting
+obsolete-variable warnings about @code{nnir-*} variables, migration is
+fairly straightforward. In addition to the variables raised by the
+warnings, all previous engine-specific variables can be updated by
+simply replacing the @code{nnir-} prefix with @code{gnus-search-}.
+For instance, @code{nnir-notmuch-program} is now
+@code{gnus-search-notmuch-program}.
+
+
@iftex
@iflatex
@chapter Message
@@ -23794,7 +23807,7 @@ On a GNU/Linux system, the @code{display} program is
included in the
ImageMagick package. For external conversion programs look for packages
with names like @code{netpbm}, @code{libgr-progs} and @code{compface}.
On Windows, you may use the packages @code{netpbm} and @code{compface}
-from @url{http://gnuwin32.sourceforge.net}. You need to add the
+from @url{https://gnuwin32.sourceforge.net}. You need to add the
@code{bin} directory to your @code{PATH} environment variable.
@c In fact only the following DLLs and binaries seem to be required:
@c compface1.dll uncompface.exe libnetpbm10.dll icontopbm.exe
@@ -26329,7 +26342,7 @@ size, it will reject insertion of new entries.
@end defvar
@defvar gnus-registry-register-all
-If this option is non-nil, the registry will register all messages, as
+If this option is non-@code{nil}, the registry will register all messages, as
you see them. This is important to making split-to-parent and
Message-ID references work correctly, as the registry needs to know
where all messages are, but it can slow down group opening and the
@@ -26429,7 +26442,7 @@ have to put a rule like this:
in your fancy split setup.
-If @code{gnus-registry-register-all} is non-nil (the default), the
+If @code{gnus-registry-register-all} is non-@code{nil} (the default), the
registry will perform splitting for all messages. If it is nil,
splitting will only happen for children of messages you've explicitly
registered.
@@ -26508,7 +26521,7 @@ Store @code{value} under @code{key} for message
@code{id}.
@defun gnus-registry-get-id-key (id key)
Get the data under @code{key} for message @code{id}. If the option
-@code{gnus-registry-register-all} is non-nil, this function will also
+@code{gnus-registry-register-all} is non-@code{nil}, this function will also
create an entry for @code{id} if one doesn't exist.
@end defun
@@ -26633,7 +26646,7 @@ connections after the system resumes. On systems
compiled with D-Bus
support (check the value of @code{(featurep 'dbusbind)}), Gnus can
register a D-Bus signal to automatically close all server connections
before the system goes to sleep. To enable this, set
-@code{gnus-dbus-close-on-sleep} to a non-nil value.
+@code{gnus-dbus-close-on-sleep} to a non-@code{nil} value.
For more information about D-Bus and Emacs, @pxref{Top,,, dbus, D-Bus
integration in Emacs}.
@@ -26911,10 +26924,17 @@ Gnus 5.10 on May 1st 2003 (24 releases).
On the January 4th 2004, No Gnus was begun.
+Gnus 5.11 was bundled with GNU Emacs 22.1 in June 2007.
+
+A version of No Gnus was released as Gnus 5.13 with GNU Emacs 23.1 in
+July 2009.
+
On April 19, 2010 Gnus development was moved to Git.
On the January 31th 2012, Ma Gnus was begun.
+Since then, Gnus has only been released together with Emacs.
+
If you happen upon a version of Gnus that has a prefixed name---``(ding)
Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'',
``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'', ``Ma Gnus''---don't
@@ -29080,8 +29100,9 @@ moving articles to a group that has not turned
auto-expire on.
@subsubsection Ma Gnus
@cindex Ma Gnus
-I'm sure there will be lots of text here. It's really spelled 真
-Gnus.
+It's really spelled 真Gnus. Ma Gnus was the code name for the
+development version of Gnus started in 2012. These days, Gnus is only
+released together with Emacs.
New features in Ma Gnus:
@@ -29111,6 +29132,8 @@ The new hooks @code{gnus-gcc-pre-body-encode-hook} and
the message body of the Gcc copy of a sent message.
@xref{Archived Messages}.
+For more recent changes, see the Emacs @file{NEWS} files.
+
@end itemize
@end itemize
diff --git a/doc/misc/message.texi b/doc/misc/message.texi
index 6a6beb7a1f..cfad4f4e07 100644
--- a/doc/misc/message.texi
+++ b/doc/misc/message.texi
@@ -1005,7 +1005,7 @@ that they can deposit messages and lock the door, while
your private
key corresponds to the opening combination for the safe.)
Thus, you need to perform the following steps for e-mail encryption,
-typically outside Emacs. See, for example, the
+typically outside Emacs. See, for example,
@uref{https://www.gnupg.org/gph/en/manual.html, The GNU Privacy
Handbook} for details covering the standard @acronym{OpenPGP} with
@acronym{GnuPG}.
diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi
index 6aa2cf290d..1a80c62edb 100644
--- a/doc/misc/mh-e.texi
+++ b/doc/misc/mh-e.texi
@@ -3082,7 +3082,7 @@ retracted---without question@footnote{In previous
versions of MH-E,
this option suppressed the confirmation in @code{mh-kill-folder}.
Since this kept most users from setting this option,
@code{mh-kill-folder} was modified in version 6.0 to always ask for
-confirmation subject to @code{mh-kill-folder-suppress-prompt-hook}.
+confirmation subject to @code{mh-kill-folder-suppress-prompt-functions}.
@xref{Folders}.}.
@cindex MH-Folder mode
@@ -3364,7 +3364,7 @@ Hook run by q before quitting MH-E (default: @code{nil}).
Hook run by @code{mh-folder-mode} when visiting a new folder (default:
@code{nil}).
@c -------------------------
-@item mh-kill-folder-suppress-prompt-hook
+@item mh-kill-folder-suppress-prompt-functions
Abnormal hook run at the beginning of @code{mh-kill-folder} (default:
@code{'mh-search-p}).
@c -------------------------
@@ -7540,8 +7540,8 @@ Allowlisted message face
@cindex spam filters, bogofilter
MH-E depends on @uref{https://spamassassin.apache.org/, SpamAssassin},
-@uref{http://bogofilter.sourceforge.net/, bogofilter}, or
-@uref{http://spamprobe.sourceforge.net/, SpamProbe} to throw the dreck
+@uref{https://bogofilter.sourceforge.net/, bogofilter}, or
+@uref{https://spamprobe.sourceforge.net/, SpamProbe} to throw the dreck
away. This chapter describes briefly how to configure these programs
to work well with MH-E and how to use MH-E's interface that provides
continuing education for these programs.
@@ -7721,7 +7721,7 @@ done by adding the following to your @file{crontab}:
Bogofilter is a Bayesian spam filtering program. Get it from your
local distribution or from the
-@uref{http://bogofilter.sourceforge.net/, bogofilter web site}.
+@uref{https://bogofilter.sourceforge.net/, bogofilter web site}.
Bogofilter is taught by running:
@@ -7791,7 +7791,7 @@ bogofilter.
@cindex spam filters, SpamProbe
SpamProbe is a Bayesian spam filtering program. Get it from your local
-distribution or from the @uref{http://spamprobe.sourceforge.net,
+distribution or from the @uref{https://spamprobe.sourceforge.net,
SpamProbe web site}.
To use SpamProbe, add the following recipes to @file{~/.procmailrc}:
@@ -8633,7 +8633,7 @@ via SourceForge (@pxref{Bug Reports}).
@cindex FAQ
@cindex MH FAQ
-The article @uref{http://www.newt.com/faq/mh.html, @cite{MH Frequently
+The article @uref{https://www.newt.com/faq/mh.html, @cite{MH Frequently
Asked Questions (FAQ) with Answers}} appears monthly in the newsgroup
@samp{comp.mail.mh}. While very little is there that deals with MH-E
specifically, there is an incredible wealth of material about MH
diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org
index 2680fe9eb5..db92dfb481 100644
--- a/doc/misc/modus-themes.org
+++ b/doc/misc/modus-themes.org
@@ -4,9 +4,9 @@
#+language: en
#+options: ':t toc:nil author:t email:t num:t
#+startup: content
-#+macro: stable-version 2.7.0
-#+macro: release-date 2022-10-01
-#+macro: development-version 2.8.0-dev
+#+macro: stable-version 3.0.0
+#+macro: release-date 2022-10-28
+#+macro: development-version 3.1.0-dev
#+macro: file @@texinfo:@file{@@$1@@texinfo:}@@
#+macro: space @@texinfo:@: @@
#+macro: kbd @@texinfo:@kbd{@@$1@@texinfo:}@@
@@ -35,6 +35,7 @@ Current development target is {{{development-version}}}.
+ Homepage: https://protesilaos.com/emacs/modus-themes.
+ Git repository: https://git.sr.ht/~protesilaos/modus-themes.
+ Mailing list: https://lists.sr.ht/~protesilaos/modus-themes.
++ Backronym: My Old Display Unexpectedly Sharpened ... themes
#+toc: headlines 8 insert TOC here, with eight headline levels
@@ -632,7 +633,7 @@ to user options to take effect
([[#h:3f3c3728-1b34-437d-9d0c-b110f5b161a9][Enabl
:end:
#+vindex: modus-themes-deuteranopia
-Brief: When non-nil use red/blue color-coding instead of red/green,
+Brief: When non-~nil~ use red/blue color-coding instead of red/green,
where appropriate.
Symbol: ~modus-themes-deuteranopia~ (=boolean= type)
@@ -679,7 +680,7 @@ Possible values:
The default is to use a bold typographic weight only when it is
required.
-With a non-nil value (~t~) display several syntactic constructs in bold
+With a non-~nil~ value (~t~) display several syntactic constructs in bold
weight. This concerns keywords and other important aspects of code
syntax. It also affects certain mode line indicators and command-line
prompts.
@@ -709,7 +710,7 @@ Possible values:
The default is to not use slanted text forms (italics) unless it is
absolutely necessary.
-With a non-nil value (~t~) choose to render more faces in italics. This
+With a non-~nil~ value (~t~) choose to render more faces in italics. This
typically affects documentation strings and code comments.
Advanced users may also want to configure the exact attributes of the
@@ -799,7 +800,7 @@ Possible values:
1. ~nil~ (default)
2. ~t~
-When set to non-nil (~t~), configure some spacing-sensitive faces like Org
+When set to non-~nil~ (~t~), configure some spacing-sensitive faces like Org
tables and code blocks to always inherit from the ~fixed-pitch~ face.
This is to ensure that certain constructs like code blocks and tables
remain monospaced even when users opt for a mode that remaps typeface
@@ -926,8 +927,8 @@ an empty list). The list can include any of the following
symbols:
the form of =(height . FLOAT)=
+ ~all-buttons~
-The default (a nil value or an empty list) is a gray background combined
-with a pseudo three-dimensional effect.
+The default (a ~nil~ value or an empty list) is a gray background
+combined with a pseudo three-dimensional effect.
The ~flat~ property makes the button two dimensional.
@@ -1068,7 +1069,7 @@ effect, color, and border visibility:
+ A floating point to set the height of the mode line's text. It can
also be a cons cell in the form of ~(height . FLOAT)~.
-The default (a nil value or an empty list) is a two-dimensional
+The default (a ~nil~ value or an empty list) is a two-dimensional
rectangle with a border around it. The active and the inactive mode
lines use different shades of grayscale values for the background,
foreground, border.
@@ -1097,7 +1098,7 @@ of NATNUM pixels at the boundaries of the mode lines.
The default value
is 1 and does not need to be specified explicitly. The padding has no
effect when the ~moody~ property is also used, because Moody already
applies its own tweaks. To ensure that the underline is placed at the
-bottom of the mode line, set ~x-underline-at-descent-line~ to non-nil
+bottom of the mode line, set ~x-underline-at-descent-line~ to non-~nil~
(this is not needed when the ~borderless~ property is also set). For
users on Emacs 29, the ~x-use-underline-position-properties~ variable must
also be set to nil.
@@ -1159,7 +1160,7 @@ colors (which have been carefully designed to be highly
accessible).
Furthermore, because Moody expects an underline and overline instead of
a box style, it is strongly advised to set ~x-underline-at-descent-line~
-to a non-nil value.
+to a non-~nil~ value.
Finally, note that various packages which heavily modify the mode line,
such as =doom-modeline=, =nano-modeline=, =powerline=, =spaceline= may not look
@@ -1183,7 +1184,7 @@ Possible values:
+ ~t~
By default, all tab interfaces use backgrounds which are shades of gray.
-When this option is set to non-nil, the backgrounds become colorful.
+When this option is set to non-~nil~, the backgrounds become colorful.
This affects the built-in ~tab-bar-mode~ and ~tab-line-mode~, as well as the
Centaur tabs package.
@@ -1202,8 +1203,9 @@ Symbol: ~modus-themes-completions~ (=alist= type
properties)
This affects Company, Corfu, Flx, Helm, Icomplete/Fido, Ido, Ivy,
Orderless, Selectrum, Vertico. The value is an alist that takes the
-form of a =(key . properties)= combination. Here is a sample, followed
-by a description of the particularities:
+form of a =(KEY . PROPERTIES)= combination. =KEY= is a symbol, while
+=PROPERTIES= is a list. Here is a sample, followed by a description
+of the particularities:
#+begin_src emacs-lisp
(setq modus-themes-completions
@@ -1213,10 +1215,10 @@ by a description of the particularities:
#+end_src
The ~matches~ key refers to the highlighted characters that correspond
-to the user's input. By default (nil or an empty list), they have a
-bold weight and a colored foreground. The list of properties may
-include any of the following symbols regardless of the order they may
-appear in:
+to the user's input. When its properties are ~nil~ or an empty list,
+matching characters in the user interface will have a bold weight and
+a colored foreground. The list of properties may include any of the
+following symbols regardless of the order they may appear in:
- ~background~ to add a background color;
@@ -1232,10 +1234,10 @@ appear in:
variable. The absence of a weight means that bold will be used.
The ~selection~ key applies to the current line or currently matched
-candidate, depending on the specifics of the User Interface. By default
-(nil or an empty list), it has a subtle gray background, a bold weight,
-and the base foreground value for the text. The list of properties it
-accepts is as follows (order is not significant):
+candidate, depending on the specifics of the user interface. When its
+properties are ~nil~ or an empty list, it has a subtle gray background,
+a bold weight, and the base foreground value for the text. The list
+of properties it accepts is as follows (order is not significant):
- ~accented~ to make the background colorful instead of gray;
@@ -1251,7 +1253,11 @@ accepts is as follows (order is not significant):
cetera. Valid symbols are defined in the ~modus-themes-weights~
variable. The absence of a weight means that bold will be used.
-The ~popup~ key takes the same values as ~selection~.
+The ~popup~ key takes the same values as ~selection~. The only
+difference is that it applies specifically to user interfaces that
+display an inline popup and thus have slightly different styling
+requirements than the minibuffer. The two prominent packages are
+=company= and =corfu=.
Apart from specifying each key separately, a fallback list is accepted.
This is only useful when the desired aesthetic is the same across all
@@ -1276,21 +1282,10 @@ corresponding key is simply ignored (~matches~ does not
have ~accented~
and ~text-also~, while ~selection~ and ~popup~ do not have
~background~).
-A concise expression of those associations can be written as follows,
-where the ~car~ is always the key and the ~cdr~ is the list of
-properties (whatever order they may appear in):
-
-#+begin_src emacs-lisp
-(setq modus-themes-completions
- '((matches extrabold background intense)
- (selection semibold accented intense)
- (popup accented)))
-#+end_src
-
[[#h:2793a224-2109-4f61-a106-721c57c01375][Configure bold and italic faces]].
-Also refer to the Orderless documentation for its intersection with
-Company (if you choose to use those in tandem).
+Also refer to the documentation of the ~orderless~ package for its
+intersection with ~company~ (if you choose to use those in tandem).
** Option for mail citations
:properties:
@@ -1312,7 +1307,7 @@ Possible values:
3. ~faint~
4. ~monochrome~
-By default (a nil value) citations are styled with contrasting hues to
+By default (a ~nil~ value) citations are styled with contrasting hues to
denote their depth. Colors are easy to tell apart because they
complement each other, but they otherwise are not very prominent.
@@ -1342,17 +1337,16 @@ Symbol: ~modus-themes-fringes~ (=choice= type)
Possible values:
-1. ~nil~ (default)
+1. ~nil~
2. ~subtle~
3. ~intense~
-The default is to use the same color as that of the main background,
-meaning that the fringes are not obvious though they still occupy the
-space given to them by ~fringe-mode~.
+When the value is nil, do not apply a distinct background color.
-Options ~subtle~ and ~intense~ apply a gray background, making the fringes
-visible. The difference between the two is one of degree, as their
-names imply.
+With a value of ~subtle~ use a gray background color that is
+visible yet close to the main background color.
+
+With ~intense~ use a more pronounced gray background color.
** Option for language checkers
:properties:
@@ -1435,16 +1429,16 @@ Brief: Control the style of the current line of
~hl-line-mode~.
Symbol: ~modus-themes-hl-line~ (=choice= type, list of properties)
-Possible values are expressed as a list of properties (default is ~nil~ or
-an empty list). The list can include any of the following symbols:
+The value is a list of properties, each designated by a symbol. With
+a ~nil~ value, or an empty list, the style is a subtle gray background
+color.
+
+Possible properties are the following symbols:
+ ~accented~
+ ~intense~
+ ~underline~
-The default (a ~nil~ value or an empty list) is a subtle gray background
-color.
-
The property ~accented~ changes the background to a colored variant.
An ~underline~ property draws a line below the highlighted area. Its
@@ -1471,8 +1465,9 @@ In user configuration files the form may look like this:
(setq modus-themes-hl-line '(underline accented))
#+end_src
-Set ~x-underline-at-descent-line~ to a non-nil value for better results
-with underlines.
+Set ~x-underline-at-descent-line~ to a non-~nil~ value so that the
+placement of the underline coincides with the lower boundary of the
+colored background.
This style affects several packages that enable ~hl-line-mode~, such as
=elfeed=, =notmuch=, and =mu4e=.
@@ -1506,7 +1501,7 @@ Similarly, the faces for
~display-line-numbers-major-tick~ and its
counterpart ~display-line-numbers-minor-tick~ use appropriate styles that
involve a bespoke background and foreground combination.
-With a non-nil value (~t~), line numbers have no background of their own.
+With a non-~nil~ value (~t~), line numbers have no background of their own.
Instead they retain the primary background of the theme, blending with
the rest of the buffer. Foreground values for all relevant faces are
updated to accommodate this aesthetic.
@@ -1529,7 +1524,7 @@ Possible value:
2. ~t~
By default all mouseover effects apply a highlight with a subtle colored
-background. When non-nil, these have a more pronounced effect.
+background. When non-~nil~, these have a more pronounced effect.
Note that this affects the generic ~highlight~ which, strictly speaking,
is not limited to mouse usage.
@@ -1713,11 +1708,11 @@ Option ~desaturated~ follows the same principles as
with the default
(~nil~), though it tones down all relevant colors.
Option ~bg-only~ applies a background but does not override the text's
-foreground. This makes it suitable for a non-nil value passed to
+foreground. This makes it suitable for a non-~nil~ value passed to
~diff-font-lock-syntax~ (note: Magit does not support syntax highlighting
in diffs---last checked on 2021-12-02).
-When the user option ~modus-themes-deuteranopia~ is non-nil, all diffs
+When the user option ~modus-themes-deuteranopia~ is non-~nil~, all diffs
will use a red/blue color-coding system instead of the standard
red/green. Other stylistic changes are made in the interest of
optimizing for such a use-case.
@@ -1776,8 +1771,8 @@ of the block. Disable the extension of such backgrounds
by setting
~org-fontify-whole-block-delimiter-line~ to nil.
Code blocks use their major mode's colors only when the variable
-~org-src-fontify-natively~ is non-nil. While quote/verse blocks require
-setting ~org-fontify-quote-and-verse-blocks~ to a non-nil value.
+~org-src-fontify-natively~ is non-~nil~. While quote/verse blocks require
+setting ~org-fontify-quote-and-verse-blocks~ to a non-~nil~ value.
[[#h:f44cc6e3-b0f1-4a5e-8a90-9e48fa557b50][Update Org block delimiter
fontification]].
@@ -1894,7 +1889,7 @@ An ~event~ key covers (i) headings with a plain time
stamp that are
shown on the agenda, also known as events, (ii) entries imported from
the diary, and (iii) other items that derive from a symbolic expression
or sexp (phases of the moon, holidays, etc.). By default all those look
-the same and have a subtle foreground color (the default is a nil value
+the same and have a subtle foreground color (the default is a ~nil~ value
or an empty list). This key accepts a list of properties. Those are:
- ~accented~ applies an accent value to the event's foreground,
@@ -1925,7 +1920,7 @@ A ~scheduled~ key applies to tasks with a scheduled date.
By default (a
~nil~ value), those use varying shades of yellow to denote (i) a past or
current date and (ii) a future date. Valid values are symbols:
-- nil (default);
+- ~nil~ (default);
- ~uniform~ to make all scheduled dates the same color;
- ~rainbow~ to use contrasting colors for past, present, future
scheduled dates.
@@ -1963,7 +1958,7 @@ passed as a symbol. Those are:
being too late. The difference between ready and clear states is
attenuated by painting both of them using shades of green. This
option thus highlights the alert and overdue states.
-- When ~modus-themes-deuteranopia~ is non-nil the exact style of the habit
+- When ~modus-themes-deuteranopia~ is non-~nil~ the exact style of the habit
graph adapts to the needs of users with red-green color deficiency by
substituting every instance of green with blue or cyan (depending on
the specifics).
@@ -2108,7 +2103,7 @@ In user configuration files the form may look like this:
#+end_src
When defining the styles per heading level, it is possible to pass a
-non-nil value (~t~) instead of a list of properties. This will retain the
+non-~nil~ value (~t~) instead of a list of properties. This will retain the
original aesthetic for that level. For example:
#+begin_src emacs-lisp
@@ -2153,7 +2148,7 @@ and tab line.
The default is to use the same font as the rest of Emacs, which usually
is a monospaced family.
-With a non-nil value (~t~) apply a proportionately spaced typeface. This
+With a non-~nil~ value (~t~) apply a proportionately spaced typeface. This
is done by assigning the ~variable-pitch~ face to the relevant items.
[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and
others]].
@@ -2839,7 +2834,7 @@ To reset the changes, we apply this and reload the theme:
Users who wish to leverage such a mechanism can opt to implement it
on-demand by means of a global minor mode. The following snippet covers
-both themes and expands to some more assosiations in the palette:
+both themes and expands to some more associations in the palette:
#+begin_src emacs-lisp
(define-minor-mode my-modus-themes-tinted
@@ -3654,7 +3649,7 @@ specification of that variable looks like this:
With the exception of ~org-verbatim~ and ~org-code~ faces, everything else
uses the corresponding type of emphasis: a bold typographic weight, or
-italicised, underlined, and struck through text.
+italicized, underlined, and struck through text.
The best way for users to add some extra attributes, such as a
foreground color, is to define their own faces and assign them to the
@@ -4681,6 +4676,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ notmuch
+ num3-mode
+ nxml-mode
++ olivetti
+ orderless
+ org*
+ org-journal
@@ -4753,7 +4749,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ tab-bar-groups
+ tab-bar-mode
+ tab-line-mode
-+ table (built-in table.el)
++ table (built-in {{{file(table.el)}}})
+ telega
+ telephone-line
+ terraform-mode
@@ -4768,7 +4764,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ tuareg
+ typescript
+ undo-tree
-+ vc (vc-dir.el, vc-hooks.el)
++ vc ({{{file(vc-dir.el)}}}, {{{file(vc-hooks.el)}}})
+ vertico
+ vertico-quick
+ vimish-fold
@@ -4793,8 +4789,7 @@ have lots of extensions, so the "full support" may not be
100% true…
+ yasnippet
+ ztree
-Plus many other miscellaneous faces that are provided by the upstream
-GNU Emacs distribution.
+Plus many other miscellaneous faces that are provided by Emacs.
** Indirectly covered packages
:properties:
@@ -5397,7 +5392,7 @@ https://github.com/tumashu/company-posframe/]
:custom_id: h:98bdf319-1e32-4469-8a01-771200fba65c
:end:
-The built-in IRC client ~erc~ has the ability to colorise any text using
+The built-in IRC client ~erc~ has the ability to colorize any text using
escape sequences that start with =^C= (inserted with {{{kbd(C-q C-c)}}}) and
are
followed by a number for the foreground and background.[fn:: This page
explains the basics, though it is not specific to Emacs:
@@ -5453,7 +5448,7 @@ Consult the doc string of ~shr-use-colors~.
By default, packages that build on top of the Simple HTML Remember (=shr=)
use proportionately spaced fonts. This is controlled by the user option
-~shr-use-fonts~, which is set to non-nil by default. To use the standard
+~shr-use-fonts~, which is set to non-~nil~ by default. To use the standard
font instead, set that variable to nil.
[[#h:defcf4fc-8fa8-4c29-b12e-7119582cc929][Font configurations for Org and
others]].
@@ -5543,9 +5538,9 @@ ANSI color number 1 (red) from the already-supported
array of
:end:
Hints are drawn by [[https://imagemagick.org/][ImageMagick]], not Emacs, i.e.,
ImageMagick doesn't
-know about the hint face unless you tell ImageMagick about it. By
+know about the hint face unless you tell ImageMagick about it. By
default, only the foreground and background color attributes are
-passed. The below snippet adds to those the various font attributes. As
+passed. The below snippet adds to those the various font attributes. As
it queries various faces, specifically ~pdf-links-read-link~ and the faces
it inherits, it needs to be added to your initialization file after
you've customized any faces.
@@ -5816,9 +5811,9 @@ In general, an additional source of light other than that
of the monitor
can help reduce eye strain: the eyes are more relaxed when they do not
have to focus on one point to gather light.
-The monitor's display settings must be accounted for. Gamma values, in
+The monitor's display settings must be accounted for. Gamma values, in
particular, need to be calibrated to neither amplify nor distort the
-perception of black. Same principle for sharpness, brightness, and
+perception of black. Same principle for sharpness, brightness, and
contrast as determined by the hardware, which all have an effect on how
text is read on the screen.
@@ -5883,7 +5878,7 @@ interface virtually unusable.
[[#h:5808be52-361a-4d18-88fd-90129d206f9b][Option for links]].
-Again, one must exercise judgement in order to avoid discrimination,
+Again, one must exercise judgment in order to avoid discrimination,
where "discrimination" refers to:
+ The treatment of substantially different magnitudes as if they were of
@@ -6125,22 +6120,22 @@ The Modus themes are a collective effort. Every bit of
work matters.
Yiltiz, Ilja Kocken, Iris Garcia, Ivan Popovych, Jeremy Friesen,
Jerry Zhang, Johannes Grødem, John Haman, Jonas Collberg, Jorge
Morais, Joshua O'Connor, Julio C. Villasante, Kenta Usami, Kevin
- Fleming, Kévin Le Gouguec, Kostadin Ninev, Len Trigg, Lennart
- C. Karssen, Luis Miguel Castañeda, Magne Hov, Manuel Uberti, Mark
- Bestley, Mark Burton, Mark Simpson, Markus Beppler, Matt Armstrong,
- Mauro Aranda, Maxime Tréca, Michael Goldenberg, Morgan Smith, Morgan
- Willcock, Murilo Pereira, Nicky van Foreest, Nicolas De Jaeghere,
- Paul Poloskov, Pengji Zhang, Pete Kazmier, Peter Wu, Philip
- Kaludercic, Pierre Téchoueyres, Przemysław Kryger, Robert Hepple,
- Roman Rudakov, Ryan Phillips, Rytis Paškauskas, Rudolf Adamkovič,
- Sam Kleinman, Samuel Culpepper, Saša Janiška, Shreyas Ragavan, Simon
- Pugnet, Tassilo Horn, Thibaut Verron, Thomas Heartman, Togan
- Muftuoglu, Tony Zorman, Trey Merkley, Tomasz Hołubowicz, Toon Claes,
- Uri Sharf, Utkarsh Singh, Vincent Foley. As well as users: Ben,
- CsBigDataHub1, Emacs Contrib, Eugene, Fourchaux, Fredrik, Moesasji,
- Nick, Summer Emacs, TheBlob42, Trey, bepolymathe, bit9tream,
- derek-upham, doolio, fleimgruber, gitrj95, iSeeU, jixiuf, okamsn,
- pRot0ta1p.
+ Fleming, Kévin Le Gouguec, Kevin Kainan Li, Kostadin Ninev, Len
+ Trigg, Lennart C. Karssen, Luis Miguel Castañeda, Magne Hov, Manuel
+ Uberti, Mark Bestley, Mark Burton, Mark Simpson, Markus Beppler,
+ Matt Armstrong, Matthias Fuchs, Mauro Aranda, Maxime Tréca, Michael
+ Goldenberg, Morgan Smith, Morgan Willcock, Murilo Pereira, Nicky van
+ Foreest, Nicolas De Jaeghere, Pablo Stafforini, Paul Poloskov,
+ Pengji Zhang, Pete Kazmier, Peter Wu, Philip Kaludercic, Pierre
+ Téchoueyres, Przemysław Kryger, Robert Hepple, Roman Rudakov, Ryan
+ Phillips, Rytis Paškauskas, Rudolf Adamkovič, Sam Kleinman, Samuel
+ Culpepper, Saša Janiška, Shreyas Ragavan, Simon Pugnet, Tassilo
+ Horn, Thibaut Verron, Thomas Heartman, Togan Muftuoglu, Tony Zorman,
+ Trey Merkley, Tomasz Hołubowicz, Toon Claes, Uri Sharf, Utkarsh
+ Singh, Vincent Foley. As well as users: Ben, CsBigDataHub1, Emacs
+ Contrib, Eugene, Fourchaux, Fredrik, Moesasji, Nick, Summer Emacs,
+ TheBlob42, Trey, bepolymathe, bit9tream, derek-upham, doolio,
+ fleimgruber, gitrj95, iSeeU, jixiuf, okamsn, pRot0ta1p.
+ Packaging :: Basil L.{{{space()}}} Contovounesios, Eli Zaretskii,
Glenn Morris, Mauro Aranda, Richard Stallman, Stefan Kangas (core
diff --git a/doc/misc/newsticker.texi b/doc/misc/newsticker.texi
index 92dba55c01..fec571d923 100644
--- a/doc/misc/newsticker.texi
+++ b/doc/misc/newsticker.texi
@@ -172,7 +172,7 @@ is fetched for the very first time.
@vindex newsticker-obsolete-item-max-age
@item newsticker-keep-obsolete-items
Obsolete headlines are removed immediately unless
-@code{newsticker-keep-obsolete-items} is non-nil in which case they
+@code{newsticker-keep-obsolete-items} is non-@code{nil} in which case they
are kept until @code{newsticker-obsolete-item-max-age} is reached.
@vindex newsticker-automatically-mark-items-as-old
diff --git a/doc/misc/octave-mode.texi b/doc/misc/octave-mode.texi
index 31d64c3d84..d7ea54198a 100644
--- a/doc/misc/octave-mode.texi
+++ b/doc/misc/octave-mode.texi
@@ -204,9 +204,10 @@ The GNU Emacs Manual}). Currently, function names can be
indexed.
@cindex ElDoc Mode Support
@vindex octave-eldoc-message-style
-ElDoc mode (@pxref{Lisp Doc,,, emacs, The GNU Emacs Manual}) is
-supported. By customizing @code{octave-eldoc-message-style} it can be
-changed from displaying one or multi line hints.
+ElDoc mode (@pxref{Programming Language Doc,,, emacs, The GNU Emacs
+Manual}) is supported. By customizing
+@code{octave-eldoc-message-style} it can be changed from displaying
+one or multi line hints.
@c @cindex TAGS
@c @cindex Emacs TAGS files
diff --git a/doc/misc/org.org b/doc/misc/org.org
index 1ce99728c6..6ad8c462cc 100644
--- a/doc/misc/org.org
+++ b/doc/misc/org.org
@@ -68,8 +68,8 @@ of Org, as well as additional information, frequently asked
questions
[[https://orgmode.org]].
#+cindex: print edition
-An earlier version (7.3) of this manual is available as a
[[http://www.network-theory.co.uk/org/manual/][paperback
-book from Network Theory Ltd.]].
+An earlier version (7.3) of this manual was published as a paperback book by
+Network Theory Ltd. in 2010.
** Installation
:PROPERTIES:
@@ -3234,7 +3234,7 @@ options:
| Link Type | Example |
|------------+----------------------------------------------------------|
-| http | =http://staff.science.uva.nl/c.dominik/= |
+| http | =https://staff.science.uva.nl/c.dominik/= |
| https | =https://orgmode.org/= |
| doi | =doi:10.1000/182= |
| file | =file:/home/dominik/images/jupiter.jpg= |
@@ -3567,7 +3567,7 @@ replacement text. Here is an example:
'(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=";)
("Nu Html Checker" . "https://validator.w3.org/nu/?doc=%h";)
("duckduckgo" . "https://duckduckgo.com/?q=%s";)
- ("omap" .
"http://nominatim.openstreetmap.org/search?q=%s&polygon=1";)
+ ("omap" .
"https://nominatim.openstreetmap.org/search?q=%s&polygon=1";)
("ads" .
"https://ui.adsabs.harvard.edu/search/q=%20author%3A\"%s\"";)))
#+end_src
@@ -3596,7 +3596,7 @@ can define them in the file with
#+cindex: @samp{LINK}, keyword
#+begin_example
-,#+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id=
+,#+LINK: bugzilla https://10.1.2.9/bugzilla/show_bug.cgi?id=
,#+LINK: duckduckgo https://duckduckgo.com/?q=%s
#+end_example
@@ -13642,7 +13642,7 @@ not have descriptions, such as these links
=[[file:img.jpg]]= or
=[[./img.jpg]]=, as direct image insertions in the final PDF output. In
the PDF, they are no longer links but actual images embedded on the
page. The LaTeX export back-end uses =\includegraphics= macro to
-insert the image. But for TikZ (http://sourceforge.net/projects/pgf/)
+insert the image. But for TikZ (https://sourceforge.net/projects/pgf/)
images, the back-end uses an ~\input~ macro wrapped within
a ~tikzpicture~ environment.
@@ -13982,7 +13982,7 @@ some text in German...
#+cindex: Markdown export
The Markdown export back-end, "md", converts an Org file to Markdown
-format, as defined at http://daringfireball.net/projects/markdown/.
+format, as defined at https://daringfireball.net/projects/markdown/.
Since it is built on top of the HTML back-end (see [[*HTML Export]]), it
converts every Org construct not defined in Markdown syntax, such as
@@ -16569,7 +16569,7 @@ identifying a reference in the bibliography.
- Each key can be qualified by a /prefix/ (e.g.\nbsp{}"see ") and/or
a /suffix/ (e.g.\nbsp{}"p.\nbsp{}123"), giving information useful or
necessary
- fo the comprehension of the citation but not included in the
+ for the comprehension of the citation but not included in the
reference.
- A single citation can cite more than one reference ; the keys are
@@ -22053,7 +22053,7 @@ MathJax are processed. When dvipng, dvisvgm, or
ImageMagick suite is
used to create images, any LaTeX environment is handled.
[fn:112] These are respectively available at
-[[http://sourceforge.net/projects/dvipng/]], [[http://dvisvgm.bplaced.net/]]
+[[https://sourceforge.net/projects/dvipng/]], [[http://dvisvgm.bplaced.net/]]
and from the ImageMagick suite. Choose the converter by setting the
variable ~org-preview-latex-default-process~ accordingly.
@@ -22123,9 +22123,9 @@ semantic relevance.
[fn:130] Please note that exported formulas are part of an HTML
document, and that signs such as =<=, =>=, or =&= have special
-meanings. See
[[http://docs.mathjax.org/en/latest/tex.html#tex-and-latex-in-html-documents][MathJax
TeX and LaTeX support]].
+meanings. See
[[https://docs.mathjax.org/en/latest/tex.html#tex-and-latex-in-html-documents][MathJax
TeX and LaTeX support]].
-[fn:131] See [[http://docs.mathjax.org/en/latest/tex.html#tex-extensions][TeX
and LaTeX extensions]] in the [[http://docs.mathjax.org][MathJax manual]] to
learn
+[fn:131] See [[https://docs.mathjax.org/en/latest/tex.html#tex-extensions][TeX
and LaTeX extensions]] in the [[https://docs.mathjax.org][MathJax manual]] to
learn
about extensions.
[fn:132] If the classes on TODO keywords and tags lead to conflicts,
@@ -22140,14 +22140,14 @@ as latexmk, can select the correct bibliography
compiler.
which requires the flag =-shell-escape= to be added to
~org-latex-pdf-process~.
-[fn:135] See
[[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open Document
Format for Office Applications
+[fn:135] See
[[https://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][Open Document
Format for Office Applications
(OpenDocument) Version 1.2]].
[fn:136] See [[http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl][MathToWeb]].
-[fn:137] See [[http://dlmf.nist.gov/LaTeXML/]].
+[fn:137] See [[https://dlmf.nist.gov/LaTeXML/]].
-[fn:138]
[[http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][OpenDocument-v1.2
Specification]]
+[fn:138]
[[https://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html][OpenDocument-v1.2
Specification]]
[fn:139] See the =<table:table-template>= element of the
OpenDocument-v1.2 specification.
@@ -22170,7 +22170,7 @@ are not evaluated when they appear in a keyword (see
[[*Summary of
In-Buffer Settings]]).
[fn:144] For noweb literate programming details, see
-http://www.cs.tufts.edu/~nr/noweb/.
+https://www.cs.tufts.edu/~nr/noweb/.
[fn:145] For more information, please refer to the commentary section
in =org-tempo.el=.
diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index 307fe55a63..84933a9ca7 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -259,7 +259,7 @@ Use @kbd{C-c C-@key{SPC}} to switch to these buffers.
@vindex rcirc-track-ignore-server-buffer-flag
If the user wishes to ignore events in the server buffer, set
-@code{rcirc-track-ignore-server-buffer-flag} to a non-nil value.
+@code{rcirc-track-ignore-server-buffer-flag} to a non-@code{nil} value.
@node Reference
@chapter Reference
@@ -693,7 +693,7 @@ buffers.
@cindex rcirc-track-abbrevate-flag
By default the channel names are abbreviated, set
-@code{rcirc-track-abbrevate-flag} to a non-nil value. This might be
+@code{rcirc-track-abbrevate-flag} to a non-@code{nil} value. This might be
interesting if the IRC activities are not tracked in the mode line,
but somewhere else.
diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi
index b30e5aeaa4..9c543a4c0f 100644
--- a/doc/misc/reftex.texi
+++ b/doc/misc/reftex.texi
@@ -3605,7 +3605,7 @@ menu. @xref{Key Bindings}.
@deffn Command reftex-toc
Show the table of contents for the current document. When called with
-one ore two @kbd{C-u} prefixes, rescan the document first.
+one or two @kbd{C-u} prefixes, rescan the document first.
@end deffn
@deffn Command reftex-label
@@ -5292,7 +5292,7 @@ Some improvements for XEmacs compatibility.
@itemize @bullet
@item
Fixed bug with @samp{%F} in a label prefix. Added new escapes
-@samp{%m} and @samp{%M} for mater file name and master directory.
+@samp{%m} and @samp{%M} for master file name and master directory.
@end itemize
@noindent @b{Version 4.24}
diff --git a/doc/misc/remember.texi b/doc/misc/remember.texi
index 9d1fe545d4..80bb6966e2 100644
--- a/doc/misc/remember.texi
+++ b/doc/misc/remember.texi
@@ -424,13 +424,6 @@ The default priority for remembered mail messages.
@section Saving to an Org Mode file
@cindex org mode, integration
-@ignore
-From org.texi:
-Up to version 6.36 Org used a special setup
-for @file{remember.el}. @file{org-remember.el} is still part of Org mode for
-backward compatibility with existing setups. You can find the documentation
-for org-remember at @url{http://orgmode.org/org-remember.pdf}.
-@end ignore
For instructions on how to integrate Remember with Org Mode,
consult @ref{Capture, , , org}.
diff --git a/doc/misc/sem-user.texi b/doc/misc/sem-user.texi
index 3141ab7c69..36e09b152e 100644
--- a/doc/misc/sem-user.texi
+++ b/doc/misc/sem-user.texi
@@ -621,7 +621,7 @@ Run the Semantic idle work function with debugging turned
on.
Semantic Idle Summary mode is a minor mode that displays a short
summary of the symbol at point, such as its function prototype, in the
echo area. Its functionality is similar to what ElDoc mode provides
-for Emacs Lisp (@pxref{Lisp Doc,,,emacs,Emacs manual}).
+for Emacs Lisp (@pxref{Programming Language Doc,,,emacs,Emacs manual}).
@deffn global-semantic-idle-summary-mode &optional arg
This command toggles Semantic Idle Summary mode in all
diff --git a/doc/misc/semantic.texi b/doc/misc/semantic.texi
index 25ba30d13c..b23e4c36fe 100644
--- a/doc/misc/semantic.texi
+++ b/doc/misc/semantic.texi
@@ -82,7 +82,7 @@ hippie-expand, and several other parts of Emacs.
To send bug reports, or participate in discussions about semantic,
use the mailing list cedet-semantic@@sourceforge.net via the URL:
-@url{http://lists.sourceforge.net/lists/listinfo/cedet-semantic}
+@url{https://lists.sourceforge.net/lists/listinfo/cedet-semantic}
@ifnottex
@insertcopying
diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi
index 6d0415cdbb..e3ef11ebc0 100644
--- a/doc/misc/ses.texi
+++ b/doc/misc/ses.texi
@@ -750,13 +750,13 @@ when you pass a cell name to the @command{ses-jump}
command (@kbd{j}),
it changes the entered cell name to that where to jump. The default
setting @code{upcase} allows you to enter the cell name in low
case. Another use of @code{ses-jump-cell-name-function} could be some
-internationalisation to convert non latin characters into latin
+internationalization to convert non latin characters into latin
equivalents to name the cell. Instead of a cell name, the function may
return cell coordinates in the form of a cons, for instance @code{(0
. 0)} for cell @code{A1}, @code{(1 . 0)} for cell @code{A2}, etc.
@vindex ses-jump-prefix-function
-@code{ses-jump-prefix-function} is a customisable variable by default
+@code{ses-jump-prefix-function} is a customizable variable by default
set to the @code{ses-jump-prefix} function. This function is called
when you give a prefix argument to the @command{ses-jump} command
(@kbd{j}). It returns a cell name or cell coordinates corresponding to
diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi
index df03dd0144..77a393192c 100644
--- a/doc/misc/sieve.texi
+++ b/doc/misc/sieve.texi
@@ -339,7 +339,7 @@ Indicate which script on the server should be active.
The Emacs Sieve package implements all or parts of a small but
hopefully growing number of RFCs and drafts documents. This chapter
lists the relevant ones. They can all be fetched from
-@uref{http://quimby.gnus.org/notes/}.
+@uref{https://quimby.gnus.org/notes/}.
@table @dfn
diff --git a/doc/misc/srecode.texi b/doc/misc/srecode.texi
index a0cbf7e33f..d7356fef58 100644
--- a/doc/misc/srecode.texi
+++ b/doc/misc/srecode.texi
@@ -1595,7 +1595,7 @@ from a user perspective during basic interactive
insertion via
NOTES ON THIS CHAPTER:
-These conventions are being worked on. Check w/ CEDET-DEVEL mailing
+These conventions are being worked on. Check with CEDET-DEVEL mailing
list if you want to support a language, or write an application and
provide your opinions on this topic. Any help is appreciated.
diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi
index 7de64829c0..403c0daa67 100644
--- a/doc/misc/tramp.texi
+++ b/doc/misc/tramp.texi
@@ -3532,9 +3532,14 @@ the @file{~/.authinfo.gpg} authentication file. The
user option
@code{tramp-completion-use-auth-sources} controls, whether such a
search is performed during completion.
+@vindex tramp-completion-use-cache
Remote hosts previously visited or hosts whose connections are kept
persistently (@pxref{Connection caching}) will be included in the
-completion lists.
+completion lists. If you want to suppress this completion because
+there are invalid entries in the persistency file, for example if the
+host configuration changes often, or if you plug your laptop to
+different networks frequently, you can set the user option
+@code{tramp-completion-use-cache} to nil.
After remote host name completion comes completion of file names on
the remote host. It works the same as with local host file completion
@@ -4220,7 +4225,7 @@ non-@code{nil}, or invoke that command with a negative
argument like
@value{tramp}'s implementation of @code{make-process} and
@code{start-file-process} requires a serious overhead for
initialization, every process invocation. This is needed for handling
-interactive dialogues when connecting the remote host (like providing
+interactive dialogs when connecting the remote host (like providing
a password), and initial environment setup.
Sometimes, this is not needed. Instead of starting a remote shell and
@@ -4248,8 +4253,9 @@ Furthermore, this approach has the following limitations:
@itemize
@item
-It works only for connection methods defined in @file{tramp-adb.el},
-@file{tramp-sh.el} and @file{tramp-sshfs.el}.
+It works only for some connection methods defined in
+@file{tramp-adb.el}, @file{tramp-container.el}, @file{tramp-sh.el} and
+@file{tramp-sshfs.el}.
@item
It does not support interactive user authentication. With
diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi
index 24c3090ef7..e5e7cccbe8 100644
--- a/doc/misc/transient.texi
+++ b/doc/misc/transient.texi
@@ -945,7 +945,7 @@ that multiple suffix commands can be bound to the same key,
provided
they are never active at the same time, see @ref{Predicate Slots}.
Unfortunately both false-positives and false-negatives are possible.
-To deal with the former use non-nil @var{KEEP-OTHER@.} To deal with the
+To deal with the former use non-@code{nil} @var{KEEP-OTHER@.} To deal with the
latter remove the conflicting binding explicitly.
@end defun
@@ -1957,7 +1957,7 @@ probably don't want that.
@item
@code{transient-suffix} and @code{transient-non-suffix} play a part when
determining whether the currently active transient prefix command
-remains active/transient when a suffix or abitrary non-suffix
+remains active/transient when a suffix or arbitrary non-suffix
command is invoked. @xref{Transient State}.
@item
diff --git a/doc/misc/url.texi b/doc/misc/url.texi
index 546639b017..420a2b56c5 100644
--- a/doc/misc/url.texi
+++ b/doc/misc/url.texi
@@ -268,7 +268,7 @@ argument is @code{nil}, the allowed characters are those
specified as
@dfn{unreserved characters} by RFC 3986 (see the variable
@code{url-unreserved-chars}). Otherwise, @var{allowed-chars} should
be either a list of allowed chars, or a vector whose Nth element is
-non-nil if character N is allowed.
+non-@code{nil} if character N is allowed.
@end defun
@defun url-unhex-string string &optional allow-newlines
diff --git a/doc/misc/vhdl-mode.texi b/doc/misc/vhdl-mode.texi
index 7d451c71bd..8abf882a29 100644
--- a/doc/misc/vhdl-mode.texi
+++ b/doc/misc/vhdl-mode.texi
@@ -892,7 +892,7 @@ list. Send email to the maintainer @email{reto@@gnu.org}
to join
either of these lists.
The official Emacs VHDL Mode Home Page can be found at
-@uref{http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html}.
+@uref{https://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html}.
@node Sample Init File
@chapter Sample Init File
diff --git a/doc/misc/vip.texi b/doc/misc/vip.texi
index df65d70cb1..8e192d7e40 100644
--- a/doc/misc/vip.texi
+++ b/doc/misc/vip.texi
@@ -1203,11 +1203,11 @@ Move point backward to the character @var{ch} on the
line. Signal error if
@var{ch} could not be found (@code{vip-find-char-backward}).
@item t @var{ch}
@kindex 164 t @r{(}@code{vip-goto-char-forward}@r{)}
-Move point forward upto the character @var{ch} on the line. Signal error if
+Move point forward up to the character @var{ch} on the line. Signal error if
@var{ch} could not be found (@code{vip-goto-char-forward}).
@item T @var{ch}
@kindex 124 T @r{(}@code{vip-goto-char-backward}@r{)}
-Move point backward upto the character @var{ch} on the line. Signal error if
+Move point backward up to the character @var{ch} on the line. Signal error if
@var{ch} could not be found (@code{vip-goto-char-backward}).
@item ;
@kindex 073 ; @r{(}@code{vip-repeat-find}@r{)}
diff --git a/etc/DEBUG b/etc/DEBUG
index f57e6f197b..ef9160a209 100644
--- a/etc/DEBUG
+++ b/etc/DEBUG
@@ -1004,7 +1004,7 @@ incompatible with the --with-dumping=unexec option of
'configure'.
** Running Emacs under Valgrind
-Valgrind <http://valgrind.org/> is free software that can be useful
+Valgrind <https://valgrind.org/> is free software that can be useful
when debugging low-level Emacs problems. Unlike GCC sanitizers,
Valgrind does not need you to compile Emacs with special debugging
flags, so it can be helpful in investigating problems that vanish when
diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS
index 988eb1e09c..f638d4717a 100644
--- a/etc/ERC-NEWS
+++ b/etc/ERC-NEWS
@@ -77,6 +77,13 @@ blanks when 'erc-send-whitespace-lines' is active. New
options have
also been added for warning when input spans multiple lines. Although
off by default, new users are encouraged to enable them.
+** URL handling has improved.
+Clicking on 'irc://' and 'ircs://' links elsewhere in Emacs now does
+the right thing most of the time. However, for security reasons,
+users are now prompted to confirm connection parameters prior to lift
+off. See the new '(erc) Integrations' section in the Info manual to
+override this.
+
** Miscellaneous behavioral changes impacting the user experience.
A bug has been fixed that saw prompts being mangled, doubled, or
erased in server buffers upon disconnection. Instead, input prompts
@@ -98,6 +105,11 @@ Although rare, server passwords containing white space are
now handled
correctly.
** Miscellaneous behavioral changes in the library API.
+A number of core macros and other definitions have been moved to a new
+file called erc-common.el. This was done to further lessen the
+various complications arising from the mutual dependency between 'erc'
+and 'erc-backend'.
+
The function 'erc-network' always returns non-nil in server and target
buffers belonging to a successfully established IRC connection, even
after that connection has been closed.
@@ -109,11 +121,14 @@ network-context identifiers via a new ':id' keyword. The
latter
carries wider significance beyond autojoin and can be used for
unequivocally identifying a connection in a human-readable way.
-The function 'erc-auto-query', unused internally, and basically
-inscrutable when read, has been deprecated with no public replacement.
-This raises a related issue: if you use ERC as a library and need
-something only offered internally, please lobby to have it exported by
-writing to emacs-erc@gnu.org.
+The function 'erc-auto-query' was deemed too difficult to reason
+through and has thus been deprecated with no public replacement; it
+has also been removed from the client code path.
+
+A few internal variables have been introduced that could just as well
+have been made public, possibly as user options. Likewise for some
+internal functions. As always, users needing such functionality
+officially exposed are encouraged to write to emacs-erc@gnu.org.
* Changes in ERC 5.4.1
diff --git a/etc/HELLO b/etc/HELLO
index b05c09da3c..7bc12063f8 100644
--- a/etc/HELLO
+++ b/etc/HELLO
@@ -41,6 +41,7 @@ C printf (<x-color><param>orange red</param>"Hello,
world!\n"</x-color>);
Cham (ꨌꩌ) ꨦꨤꩌ ꨦꨁꨰ
Cherokee (ᏣᎳᎩ ᎦᏬᏂᎯᏍᏗ) ᎣᏏᏲ / ᏏᏲ
Comanche /kəˈmæntʃiː/ Haa marʉ́awe
+Coptic (ⲘⲉⲧⲢⲉⲙ̀ⲛⲭⲏⲙⲓ) Ⲛⲟⲩϥⲣⲓ
Cree (ᓀᐦᐃᔭᐍᐏᐣ) ᑕᓂᓯ / ᐙᒋᔮ
Czech (čeština) Dobrý den
Danish (dansk) Hej / Goddag / Halløj
diff --git a/etc/NEWS b/etc/NEWS
index e456476f00..5a65896d69 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -105,29 +105,21 @@ configuration on X is known to have problems, such as
undesirable
frame positioning and various issues with keyboard input of sequences
such as 'C-;' and 'C-S-u'.
+---
+** The implementation of overlays has changed.
+Emacs now uses an implementation of overlays that is much more
+efficient than the original one, and should speed up all the
+operations that involve overlays, especially when there are lots of
+them in a buffer. However, no changes in behavior of overlays should
+be visible on the Lisp or user level, with the exception of better
+performance and the order of overlays returned by functions that don't
+promise any particular order.
+
---
** The docstrings of preloaded files are not in "etc/DOC" any more.
Instead, they're fetched as needed from the corresponding ".elc" file,
as was already the case for all the non-preloaded files.
-** Emacs Sessions (Desktop)
-
-+++
-*** New user option to load a locked desktop if locking Emacs is not running.
-The option 'desktop-load-locked-desktop' can now be set to the value
-'check-pid', which means to allow loading a locked ".emacs.desktop"
-file if the Emacs process which locked it is no longer running on the
-local machine. This allows avoiding questions about locked desktop
-files when the Emacs session which locked it crashes, or was otherwise
-interrupted, and didn't exit gracefully. See the "(emacs) Saving
-Emacs Sessions" node in the Emacs manual for more details.
-
-** Miscellaneous
-
-+++
-*** User option 'minibuffer-eldef-shorten-default' is now obsolete.
-Customize the user option 'minibuffer-default-prompt-format' instead.
-
* Startup Changes in Emacs 29.1
@@ -173,7 +165,7 @@ time.
+++
*** New variable 'inhibit-automatic-native-compilation'.
If set, Emacs will inhibit native compilation (and won't write
-anything to the eln cache automatically). The variable is initialised
+anything to the eln cache automatically). The variable is initialized
from the 'EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION' environment
variable on Emacs startup.
@@ -356,6 +348,11 @@ previous 'C-x ='.
** Eshell
+*** Eshell's PATH is now derived from 'exec-path'.
+For consistency with remote connections, Eshell now uses 'exec-path'
+to determine the execution path on the local system, instead of using
+the PATH environment variable directly.
+
---
*** 'source' and '.' no longer accept the '--help' option.
This is for compatibility with the shell versions of these commands,
@@ -374,6 +371,11 @@ node in the Eshell manual for more details.
*** Eshell pipelines now only pipe stdout by default.
To pipe both stdout and stderr, use the '|&' operator instead of '|'.
+*** New eshell built-in command 'doas'.
+The privilege-escalation program 'doas' has been added to the existing
+'su' and 'sudo' commands from the 'eshell-tramp' module. The external
+command may still be accessed by using '*doas'.
+
---
** The 'delete-forward-char' command now deletes by grapheme clusters.
This command is by default bound to the <Delete> function key
@@ -437,6 +439,12 @@ The user options 'url-gateway-rlogin-host',
'url-gateway-rlogin-parameters', and 'url-gateway-rlogin-user-name'
are also obsolete.
+---
+** The user function 'url-irc-function' now takes a 'scheme' argument.
+The user option 'url-irc-function' is now called with a sixth argument
+corresponding to the scheme portion of the target URL. For example,
+this would be "ircs" for a URL like "ircs://irc.libera.chat".
+
---
** The linum.el library is now obsolete.
We recommend using either the built-in 'display-line-numbers-mode', or
@@ -710,6 +718,15 @@ part of the buffer.
+++
** 'count-words' will now report sentence count when used interactively.
+** New user option 'set-message-functions'.
+It allows selecting more functions for 'set-message-function'
+in addition to the default function that handles messages
+in the active minibuffer. The most useful are 'inhibit-message'
+that allows specifying a list of messages to inhibit via
+'inhibit-message-regexps', and 'set-multi-message' that
+accumulates recent messages and displays them stacked
+in the echo area.
+
---
** New user option 'find-library-include-other-files'.
If set to nil, commands like 'find-library' will only include library
@@ -823,22 +840,6 @@ This means Emacs built with GNUstep or built on macOS is
now able to
display different faces and images inside tooltips when the
'use-system-tooltips' user option is nil.
-** Connection-local variables
-
-+++
-*** Some connection-local variables are now user options.
-The variables 'connection-local-profile-alist' and
-'connection-local-criteria-alist' are now user options, in order to
-make it more convenient to inspect and modify them.
-
-+++
-*** The default connection-local application can be changed temporarily.
-Running 'with-connection-local-variables' defaults to application
-'tramp'. This can be changed by let-binding
-'connection-local-default-application' to another symbol. This is
-useful when running code in a buffer where Tramp has already set some
-connection-local variables.
-
---
** New minor mode 'pixel-scroll-precision-mode'.
When enabled, and if your mouse supports it, you can scroll the
@@ -1032,6 +1033,12 @@ The apropos commands will now select the apropos window
if
If the symbol at point is a keymap, 'describe-keymap' suggests it as
the default candidate.
+---
+*** New command 'help-quick' displays an overview of common commands.
+The command pops up a buffer at the bottom of the screen with a few
+helpful commands for various tasks. You can toggle the display using
+'C-h q'.
+
** Outline Mode
+++
@@ -1049,15 +1056,11 @@ or is itself too long.
+++
*** New user option 'outline-minor-mode-use-buttons'.
If non-nil, Outline Minor Mode will use buttons to hide/show outlines
-in addition to the ellipsis. The default is nil in editing modes, but
-non-nil in 'help-mode' and its derivatives.
-
-+++
-*** New user option 'outline-minor-mode-use-margins'.
-If non-nil, Outline Minor Mode will use the window margins to
-hide/show outlines in addition to the ellipsis. The default is
-non-nil in 'special-mode' and its derivatives, and it can be used in
-editing modes.
+in addition to the ellipsis. The default is nil, but in 'help-mode'
+it has the value 'insert' that inserts the buttons directly to the
+buffer where you can use 'RET' to cycle outline visibility. When
+the value is 'in-margins', Outline Minor Mode uses the window margins
+to hide/show outlines.
** Windows
@@ -1102,6 +1105,13 @@ the corresponding deleted frame.
** Tab Bars and Tab Lines
+---
+*** New user option 'tab-bar-auto-width' to automatically determine tab width.
+This option is non-nil by default, which resizes tab-bar tabs so that
+their width is evenly distributed across the tab bar. A companion
+option 'tab-bar-auto-width-max' controls the maximum width of a tab
+before its name on display is truncated.
+
---
*** 'C-x t RET' creates a new tab when the provided tab name doesn't exist.
@@ -1346,6 +1356,7 @@ Mende Kikakui script and language environment
Wancho script and language environment
Toto script and language environment
Gothic script and language environment
+Coptic script and language environment
---
*** The "Oriya" language environment was renamed to "Odia".
@@ -1369,6 +1380,16 @@ The default input method for the Tamil language
environment is now
change the input method's translation rules, customize the user option
'tamil-translation-rules'.
+---
+*** New tamil99 input method for the Tamil language.
+This supports the keyboard layout specifically designed for the Tamil
+language.
+
+---
+*** New input method 'slovak-qwerty'.
+This is a variant of the 'slovak' input method, which corresponds to
+the QWERTY Slovak keyboards.
+
* Changes in Specialized Modes and Packages in Emacs 29.1
@@ -1383,6 +1404,19 @@ the ecomplete database.
*** New user option 'ecomplete-auto-select'.
If non-nil and there's only one matching option, auto-select that.
+---
+*** New user option 'ecomplete-filter-regexp'.
+If non-nil, this user option describes what entries not to add to the
+database stored on disk.
+
+** Auth-Source
+
++++
+*** New user option 'auth-source-pass-extra-query-keywords'.
+Whether to recognize additional keyword params, like ':max' and
+':require', as well as accept lists of query terms paired with
+applicable keywords.
+
** Dired
+++
@@ -1438,8 +1472,8 @@ This command visits the file on the current line with EWW.
** Elisp
---
-*** New command 'elisp-eval-buffer' (bound to 'C-c C-e').
-This command evals the forms in the current buffer.
+*** New command 'elisp-eval-region-or-buffer' (bound to 'C-c C-e').
+This command evals the forms in the active region or in the whole buffer.
---
*** New commands 'elisp-byte-compile-file' and 'elisp-byte-compile-buffer'.
@@ -1479,6 +1513,10 @@ This controls how statements like the following are
indented:
It is enabled by default, but requires that the external "shellcheck"
command is installed.
+** CC Mode
+---
+*** C++ Mode now supports most of the new features in the C++20 standard.
+
** Cperl Mode
---
@@ -1558,6 +1596,48 @@ These commands can be useful if the ".elc" files are out
of date
If no packages are marked, 'x' will install the package under point if
it isn't already, and remove it if it is installed.
++++
+*** New command 'package-vc-install'
+Packages can now be installed directly from source by cloning from a
+repository.
+
++++
+*** New command 'package-vc-install-from-checkout'
+An existing checkout can now be loaded via package.el, by creating a
+symbolic link from the usual package directory to the checkout.
+
++++
+*** New command 'package-vc-checkout'
+Used to fetch the source of a package by cloning a repository without
+activating the package.
+
++++
+*** New command 'package-vc-prepare-patch'
+This command allows you to send patches to package maintainers, for
+packages checked out using 'package-vc-install'.
+
++++
+*** New command 'package-report-bug'
+This command helps you compose an email for sending bug reports to
+package maintainers.
+
++++
+*** New user option 'package-vc-selected-packages'
+By customizing this user option you can specify specific packages to
+install.
+
+** Emacs Sessions (Desktop)
+
++++
+*** New user option to load a locked desktop if locking Emacs is not running.
+The option 'desktop-load-locked-desktop' can now be set to the value
+'check-pid', which means to allow loading a locked ".emacs.desktop"
+file if the Emacs process which locked it is no longer running on the
+local machine. This allows avoiding questions about locked desktop
+files when the Emacs session which locked it crashes, or was otherwise
+interrupted, and didn't exit gracefully. See the "(emacs) Saving
+Emacs Sessions" node in the Emacs manual for more details.
+
** Miscellaneous
+++
@@ -1634,7 +1714,7 @@ This mode adds some highlighting, fixes the 'M-q'
command, and has
commands for doing maintenance of the Emacs NEWS files. In addition,
this mode turns on 'outline-minor-mode', and thus displays
customizable icons (see 'icon-preference') in the margins. To
-disable these icons, customize 'outline-minor-mode-use-margins' to a
+disable these icons, set 'outline-minor-mode-use-buttons' to a
nil value.
---
@@ -1696,6 +1776,10 @@ but completes on the history items instead of the
default completion
table. 'minibuffer-complete-defaults' ('C-x <down>') completes
on the list of default items.
++++
+*** User option 'minibuffer-eldef-shorten-default' is now obsolete.
+Customize the user option 'minibuffer-default-prompt-format' instead.
+
+++
*** New user option 'completions-sort'.
This option controls the sorting of the completion candidates in
@@ -1852,8 +1936,6 @@ with the changes against the last commit, e.g. with 'C-x
v D'
want to commit. Finally, type 'C-x v v' in that diff buffer to commit
only part of your changes, those whose hunks were left in the buffer.
-Currently this feature works only with the Git as 'vc-backend'.
-
---
*** 'C-x v v' on an unregistered file will now use the most specific backend.
Previously, if you had an SVN-covered "~/" directory, and a Git-covered
@@ -1873,6 +1955,24 @@ Git commands display summary lines. See the two new
user options
It is used to style the line that separates the 'log-edit' headers
from the 'log-edit' summary.
+---
+*** The function 'vc-read-revision' accepts a new MULTIPLE argument.
+If non-nil, multiple revisions can be queried. This is done using
+'completing-read-multiple'.
+
+---
+*** New function 'vc-read-multiple-revisions'.
+This function invokes 'vc-read-revision' with a non-nil value for
+MULTIPLE.
+
++++
+*** New command 'vc-prepare-patch'.
+Patches for any version control system can be prepared using VC. The
+command will query what commits to send and will compose messages for
+your mail user agent. The behavior of 'vc-prepare-patch' can be
+modified by the user options 'vc-prepare-patches-separately' and
+'vc-default-patch-addressee'.
+
** Message
---
@@ -1900,6 +2000,13 @@ It narrows to the current node.
** EUDC
++++
+*** New user option 'eudc-ignore-options-file' that defaults to 'nil'
+The 'eudc-ignore-options-file' user option can be configured to ignore
+the 'eudc-options-file' (typically "~/.emacs.d/eudc-options"). Most
+users should configure this to 't' and put EUDC configuration in the
+main Emacs initialization file (".emacs" or "~/.emacs.d/init.el").
+
+++
*** 'eudc-expansion-overwrites-query' to 'eudc-expansion-save-query-as-kill'.
'eudc-expansion-overwrites-query' is renamed to
@@ -1946,6 +2053,18 @@ The EUDC back-end for the macOS Contacts app now
provides a wider set
of attributes to use for queries, and delivers more attributes in
query results.
++++
+*** New back-end for ecomplete
+A new back-end for ecomplete allows information from that database to
+be queried by EUDC, too. The attributes present in the EUDC query are
+used to select the entry type in the ecomplete database.
+
++++
+*** New back-end for mailabbrev
+A new back-end for mailabbrev allows information from that database to
+be queried by EUDC, too. The attributes email, name, and firstname
+are supported only.
+
** EWW/SHR
+++
@@ -2034,6 +2153,25 @@ Formerly it was a pair of numbers '(A B)' that
represented 65536*A + B,
to cater to older Emacs implementations that lacked bignums.
The older form still works but is undocumented.
+** Rmail
+
+---
+*** Rmail partial summaries can now be applied one on top of the other.
+You can now narrow the set of messages selected by Rmail summary's
+criteria (recipients, topic, senders, etc.) by making a summary of the
+already summarized messages. For example, invoking
+'rmail-summary-by-senders', followed by 'rmail-summary-by-topic' will
+produce a summary where both the senders and the topic are according
+to your selection. The new user option
+'rmail-summary-progressively-narrow' controls whether the stacking of
+the filters is in effect; customize it to a non-nil value to enable
+this feature.
+
+---
+*** New Rmail summary: by thread.
+The new command 'rmail-summary-by-thread' produces a summary of
+messages that belong to a single thread of discussion.
+
** EIEIO
+++
@@ -2096,6 +2234,10 @@ it with new 'term-{faint,italic,slow-blink,fast-blink}'
faces.
*** 'project-find-file' and 'project-or-external-find-file' now accept
a prefix argument which is interpreted to mean "include all files".
++++
+*** New command 'project-list-buffers' bound to 'C-x p C-b'.
+This command displays a list of buffers from the current project.
+
+++
*** 'project-kill-buffers' can display the list of buffers to kill.
Customize the user option 'project-kill-buffers-display-buffer-list'
@@ -2500,6 +2642,12 @@ the user requesting such a connection, and not of the
user who is the
target. This has always been needed, just the password prompt and the
related 'auth-sources' entry were wrong.
++++
+*** New user option 'tramp-completion-use-cache'.
+During user and host name completion in the minibuffer, results from
+Tramp's connection cache are taken into account. This can be disabled
+by setting the user option 'tramp-completion-use-cache' to nil.
+
** Browse URL
---
@@ -2508,6 +2656,17 @@ This user option decides which URL scheme that
'browse-url' and
related functions will use by default. For example, you could
customize this to "https" to always prefer HTTPS URLs.
+---
+*** New user option 'browse-url-irc-function'.
+This option specifies a function for opening irc:// links. It
+defaults to the new function 'browse-url-irc'.
+
+---
+*** New function 'browse-url-irc'.
+This multipurpose autoloaded function can be used for opening irc://
+and ircs:// URLS by any caller that passes a URL string as an initial
+arg.
+
---
*** Support for the Netscape web browser has been removed.
This support has been obsolete since Emacs 25.1. The final version of
@@ -2579,7 +2738,7 @@ otherwise be returned.
*** Concatenating Eshell expansions now works more similarly to other shells.
When concatenating an Eshell expansion that returns a list, "adjacent"
elements of each operand are now concatenated together,
-e.g. '$list("a" "b")c' returns '("a" "bc")'. See the "(eshell)
+e.g. '$(list "a" "b")c' returns '("a" "bc")'. See the "(eshell)
Expansion" node in the Eshell manual for more details.
+++
@@ -2629,6 +2788,14 @@ commands with a warning face as you type.
*** New user option 'calc-kill-line-numbering'.
Set it to nil to exclude line numbering from kills and copies.
+** Hierarchy
+
++++
+*** Tree Display can delay computation of children.
+'hierarchy-add-tree' and 'hierarchy-add-trees' have an optional
+argument which allows tree-widget display to be activated and computed
+only when the user expands the node.
+
** Miscellaneous
---
@@ -2726,6 +2893,9 @@ remote host are shown. Alternatively, the user option
*** 'outlineify-sticky' command is renamed to 'allout-outlinify-sticky'.
The old name is still available as an obsolete function alias.
+---
+*** The url-irc library now understands ircs:// links.
+
---
*** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'.
It copies the current line into the kill ring.
@@ -2738,6 +2908,13 @@ name.
* New Modes and Packages in Emacs 29.1
++++
+** Eglot: Emacs Client for the Language Server Protocol.
+Emacs now comes with the Eglot package, which enhances various Emacs
+features, such as completion, documentation, error detection, etc.,
+based on data provided by language servers using the Language Server
+Protocol (LSP).
+
+++
** New commands 'image-crop' and 'image-cut.
These commands allow interactively cropping/cutting the image at
@@ -2855,6 +3032,11 @@ Previously, ';;;###' specs inside a top-level form
(i.e., something
like '(when ... ;;;### ...)' would be ignored. They are now parsed as
normal.
+---
+** Themes have special autoload cookies.
+All built-in themes are scraped for ';;;###theme-autoload' cookies
+that are loaded along with the regular auto-loaded code.
+
+++
** 'buffer-modified-p' has been extended.
This function was previously documented to return only nil or t. This
@@ -3167,6 +3349,22 @@ The following generalized variables have been made
obsolete:
* Lisp Changes in Emacs 29.1
++++
+** Interpreted closures are "safe for space".
+As was already the case for byte-compiled closures, instead of capturing
+the whole current lexical environment, interpreted closures now only
+capture the part of the environment that they need.
+The previous behavior could occasionally lead to memory leaks or
+to problems where a printed closure would not be 'read'able because
+of an un'read'able value in an unrelated lexical variable.
+
++++
+** New accessor function 'file-attribute-file-identifier'.
+It returns the list of the inode number and device identifier
+retrieved by 'file-attributes'. This value can be used to identify a
+file uniquely. The device identifier can be a single number or (for
+remote files) a cons of 2 numbers.
+
+++
** New macro 'while-let'.
This is like 'when-let', but repeats until a binding form is nil.
@@ -3216,6 +3414,33 @@ TIMEOUT is the idle time after which to deactivate the
transient map.
The default timeout value can be defined by the new variable
'set-transient-map-timeout'.
+** Connection-local variables
+
++++
+*** Some connection-local variables are now user options.
+The variables 'connection-local-profile-alist' and
+'connection-local-criteria-alist' are now user options, in order to
+make it more convenient to inspect and modify them.
+
++++
+*** New function 'connection-local-update-profile-variables'.
+This function allows to modify the settings of an existing
+connection-local profile.
+
++++
+*** New macro 'with-connection-local-application-variables'.
+This macro works like 'with-connection-local-variables', but it allows
+to use another application but 'tramp'. This is useful when running
+code in a buffer where Tramp has already set some connection-local
+variables.
+
++++
+*** New macro 'setq-connection-local'.
+This allows dynamically setting variable values for a particular
+connection within the body of 'with-connection-local-{application-}variables'.
+See the "(elisp) Connection Local Variables" node in the Lisp
+Reference manual for more information.
+
+++
** 'plist-get', 'plist-put' and 'plist-member' are no longer limited to 'eq'.
These function now take an optional comparison predicate argument.
@@ -3889,6 +4114,12 @@ This function allows defining a number of keystrokes
with one form.
** New macro 'defvar-keymap'.
This macro allows defining keymap variables more conveniently.
+** 'defvar-keymap' can specify 'repeat-mode' behavior for the keymap.
+Use ':repeat t' to have all bindings be repeatable or for more
+advanced usage:
+
+ ':repeat (:enter (commands ...) :exit (commands ...))'
+
---
** 'kbd' can now be used in built-in, preloaded libraries.
It no longer depends on edmacro.el and cl-lib.el.
@@ -4178,5 +4409,5 @@ Local variables:
coding: utf-8
mode: outline
mode: emacs-news
-paragraph-separate: "[ ]*$"
+paragraph-separate: "[ ]"
end:
diff --git a/etc/NEWS.21 b/etc/NEWS.21
index 6c25a76378..a718283191 100644
--- a/etc/NEWS.21
+++ b/etc/NEWS.21
@@ -217,7 +217,7 @@ Default is 'grow-only'.
** LessTif support.
Emacs now runs with the LessTif toolkit (see
-<http://lesstif.sourceforge.net>). You will need version 0.92.26, or later.
+<https://lesstif.sourceforge.net>). You will need version 0.92.26, or later.
** LessTif/Motif file selection dialog.
diff --git a/etc/NEWS.22 b/etc/NEWS.22
index d7b26dda51..b4ecbe7039 100644
--- a/etc/NEWS.22
+++ b/etc/NEWS.22
@@ -3540,7 +3540,7 @@ read-only on computers that are administered by someone
else.
PBM and XBM images are supported out of the box. Other image formats
depend on external libraries. All of these libraries have been ported
to Windows, and can be found in both source and binary form at
-http://gnuwin32.sourceforge.net/. Note that libpng also depends on
+https://gnuwin32.sourceforge.net/. Note that libpng also depends on
zlib, and tiff depends on the version of jpeg that it was compiled
against. For additional information, see nt/INSTALL.
diff --git a/etc/NEWS.25 b/etc/NEWS.25
index d1e43e0538..e716f8194f 100644
--- a/etc/NEWS.25
+++ b/etc/NEWS.25
@@ -72,7 +72,7 @@ using large fonts, at the price of a larger memory footprint.
** The version number of CC Mode has been changed from 5.33 to
5.32.99, although the software itself hasn't changed. This aims to
reduce confusion with the standalone CC Mode 5.33 (available from
-http://cc-mode.sourceforge.net), which is a more mature version than
+https://cc-mode.sourceforge.net), which is a more mature version than
the one included in Emacs 25.2.
diff --git a/etc/NEWS.26 b/etc/NEWS.26
index 50a711a0d1..9a6a799208 100644
--- a/etc/NEWS.26
+++ b/etc/NEWS.26
@@ -1223,7 +1223,7 @@ specialized for editing freedesktop.org desktop entries.
editing Less files.
** New package 'auth-source-pass' integrates 'auth-source' with the
-password manager password-store (http://passwordstore.org).
+password manager password-store (https://passwordstore.org).
* Incompatible Lisp Changes in Emacs 26.1
diff --git a/etc/NEWS.27 b/etc/NEWS.27
index f67a8c70d4..f4fb4e3121 100644
--- a/etc/NEWS.27
+++ b/etc/NEWS.27
@@ -2763,7 +2763,7 @@ not waiting for a process to be set up.
This variable determines how many bytes can be read from a sub-process
in one read operation. The default, 4096 bytes, was previously a
hard-coded constant. Setting it to a larger value might enhance
-throughput of reading from sub-processes that produces vast
+throughput of reading from sub-processes that produce vast
(megabytes) amounts of data in one go.
** The new user option 'quit-window-hook' is now run first when
diff --git a/etc/NEWS.28 b/etc/NEWS.28
index 1edf4e85b0..9982296aaa 100644
--- a/etc/NEWS.28
+++ b/etc/NEWS.28
@@ -199,7 +199,7 @@ lacks the terminfo database, you can instruct Emacs to
support 24-bit
true color by setting 'COLORTERM=truecolor' in the environment. This is
useful on systems such as FreeBSD which ships only with "etc/termcap".
-** File names given on the command line are now be pushed onto history.
+** File names given on the command line are now pushed onto history.
The file names will be pushed onto 'file-name-history', like the names
of files visited via 'C-x C-f' and other commands.
@@ -2771,7 +2771,7 @@ If non-nil, it is a regexp that should match a valid
cover image.
*** 'shell-script-mode' now supports 'outline-minor-mode'.
The outline headings have lines that start with "###".
-*** fileloop will now skip missing files instead of signalling an error.
+*** fileloop will now skip missing files instead of signaling an error.
*** 'tabulated-list-mode' can now restore original display order.
Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode',
diff --git a/etc/NEXTSTEP b/etc/NEXTSTEP
index dacbed2045..0570f70795 100644
--- a/etc/NEXTSTEP
+++ b/etc/NEXTSTEP
@@ -206,7 +206,7 @@ Release History
keys, fix border and box drawing, remove
glitches in modeline drawing, support
overstrike for unavailable bold fonts, fix XPM
- related crasher bugs. Incremental font
+ related crashes. Incremental font
metrics caching and other performance
improvements. Shared-lisp builds now possible.
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 3c164b1282..3b6ab2e2ad 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -2847,7 +2847,7 @@ can pass the converted path to the =sqlcmd= tool.
**** Improved support of header arguments for postgresql
-The postgresql engine in a sql code block supports now ~:dbport~ nd
+The postgresql engine in a sql code block now supports ~:dbport~ and
~:dbpassword~ as header arguments.
**** Support for additional plantuml output formats
@@ -5763,7 +5763,7 @@ that Calc formulas can operate on them.
**** org-ctags.el (Paul Sexton)
Targets like =<<my target>>= can now be found by Emacs' etag
- functionality, and Org-mode links can be used to to link to
+ functionality, and Org-mode links can be used to link to
etags, also in non-Org-mode files. For details, see the file
/org-ctags.el/.
@@ -6120,7 +6120,7 @@ that Calc formulas can operate on them.
code that is actually evaluated comprises the code block contents,
augmented with the extra code which assigns the referenced data to
variables. It is now possible to preview expanded contents, and
- also to expand code during during tangling. This expansion takes
+ also to expand code during tangling. This expansion takes
into account all header arguments, and variables.
A new keybinding `C-c M-b p' bound to `org-babel-expand-src-block'
@@ -6235,7 +6235,7 @@ that Calc formulas can operate on them.
**** Localized clock tables
- Clock tables now support a new new =:lang= parameter, allowing
+ Clock tables now support a new =:lang= parameter, allowing
the user to customize the localization of the table headers. See
the variable =org-clock-clocktable-language-setup= which controls
available translated strings.
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index ed2bc1ae05..2169ed0f80 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -1229,6 +1229,17 @@ you should use an Emacs input method instead.
** X keyboard problems
+*** `x-focus-frame' fails to activate the frame.
+
+Some window managers prevent `x-focus-frame' from activating the given
+frame when Emacs is in the background.
+
+Emacs tries to work around this problem by default, but the workaround
+does not work on all window managers. You can try different
+workarounds by changing the value of `x-allow-focus-stealing' (see its
+doc string for more details). The value `imitate-pager' may be
+required on some versions of KWin.
+
*** You "lose characters" after typing Compose Character key.
This is because the Compose Character key is defined as the keysym
@@ -1629,16 +1640,21 @@ X expects to find it.
*** Improving performance with slow X connections.
-There are several ways to improve this performance, any subset of which can
-be carried out at the same time:
+There are several ways to improve this performance, any subset of
+which can be carried out at the same time:
+
+1) Use the "--with-x-toolkit=no" build of Emacs. By not relying on
+ any toolkit (exhibiting potentially slow behavior), it has been
+ made very fast over networks exhibiting high latency, but suitable
+ bandwidth.
-1) If you don't need X Input Methods (XIM) for entering text in some
+2) If you don't need X Input Methods (XIM) for entering text in some
language you use, you can improve performance on WAN links by using
the X resource useXIM to turn off use of XIM. This does not affect
the use of Emacs's own input methods, which are part of the Leim
package.
-2) If the connection is very slow, you might also want to consider
+3) If the connection is very slow, you might also want to consider
switching off scroll bars, menu bar, and tool bar. Adding the
following forms to your .emacs file will accomplish that, but only
after the initial frame is displayed:
@@ -1654,26 +1670,45 @@ be carried out at the same time:
Emacs.menuBar: off
Emacs.toolBar: off
-3) Use ssh to forward the X connection, and enable compression on this
+4) Use ssh to forward the X connection, and enable compression on this
forwarded X connection (ssh -XC remotehostname emacs ...).
-4) Use lbxproxy on the remote end of the connection. This is an interface
- to the low bandwidth X extension in most modern X servers, which
- improves performance dramatically, at the slight expense of correctness
- of the X protocol. lbxproxy achieves the performance gain by grouping
- several X requests in one TCP packet and sending them off together,
- instead of requiring a round-trip for each X request in a separate
- packet. The switches that seem to work best for emacs are:
- -noatomsfile -nowinattr -cheaterrors -cheatevents
- Note that the -nograbcmap option is known to cause problems.
- For more about lbxproxy, see:
+ Keep in mind that this does not help with latency problems, only
+ andwidth ones.
+
+5) Use lbxproxy on the remote end of the connection. This is an
+ interface to the low bandwidth X extension in some outdated X
+ servers, which improves performance dramatically, at the slight
+ expense of correctness of the X protocol. lbxproxy achieves the
+ performance gain by grouping several X requests in one TCP packet
+ and sending them off together, instead of requiring a round-trip
+ for each X request in a separate packet. The switches that seem to
+ work best for emacs are: -noatomsfile -nowinattr -cheaterrors
+ -cheatevents Note that the -nograbcmap option is known to cause
+ problems. For more about lbxproxy, see:
http://www.x.org/archive/X11R6.8.0/doc/lbxproxy.1.html
-5) If copying and killing is slow, try to disable the interaction with the
+ Keep in mind that lbxproxy and the LBX extension are now obsolete.
+
+6) If copying and killing is slow, try to disable the interaction with the
native system's clipboard by adding these lines to your .emacs file:
+
(setq interprogram-cut-function nil)
(setq interprogram-paste-function nil)
+7) If selecting text with the mouse is slow, the main culprit is
+ likely `select-active-regions', coupled with a program monitoring
+ the clipboard on the X server you are connected to. Try turning
+ that off.
+
+ However, over networks with moderate to high latency, with no
+ clipboard monitor running, the bottleneck is likely to be
+ `mouse-position' instead. Set the variable
+ `x-use-fast-mouse-position' to either any non-nil value, or to the
+ symbol `really-fast' if that is still too slow. Doing so will also
+ cause Emacs features that relies on accurate mouse position
+ reporting to stop working reliably.
+
*** Emacs gives the error, Couldn't find per display information.
This can result if the X server runs out of memory because Emacs uses
diff --git a/etc/TODO b/etc/TODO
index d884539037..bf30436270 100644
--- a/etc/TODO
+++ b/etc/TODO
@@ -509,7 +509,7 @@ Also for listing fonts, displaying a font as a sample, etc.
** Program Enriched mode to read and save in RTF
Is there actually a decent single definition of RTF? Maybe see info at
-http://latex2rtf.sourceforge.net/.
+https://latex2rtf.sourceforge.net/.
This task seems to be addressed by
https://savannah.nongnu.org/projects/emacs-rtf/, which is still in
@@ -886,7 +886,6 @@ window associated with that modeline.
https://lists.gnu.org/r/emacs-devel/2007-09/msg02416.html
** Random things that were planned for Emacs-24
-
Stefan Monnier writes: "Random things that cross my mind right now
that I'd like to see. Some of them from my local hacks, but it's not
obvious at all whether they'll make it."
@@ -1737,11 +1736,18 @@
https://lists.gnu.org/r/emacs-devel/2012-06/msg00354.html
** Maybe replace lib-src/rcs2log with a Lisp implementation
It wouldn't have to be a complete replacement, just enough
for vc-rcs-update-changelog.
+
** Allow Emacs to use the bottom-right corner of a TTY
Emacs doesn't use the bottom-right corner of a TTY when terminfo
capability "am" (auto_right_margin) is defined. It could use the
bottom-right corner nonetheless when certain other capabilities are
defined. See bug#57607.
+
+** Replace tramp-archive.el by a native libarchive(3) implementation.
+The former is based on the GVFS archive backend, which makes it
+available on GNU/Linux only. That implementation has further
+drawbacks like it doesn't support to write into archives.
+
* Other known bugs
** 'make-frame' forgets unhandled parameters, at least for X11 frames
@@ -1764,7 +1770,7 @@ The MPX code has not been tested under X toolkit or GTK+
2.x builds
and is not expected to work there.
** Framework for doing animations
-Emacs does animations all over the place, usually "pluse" animations.
+Emacs does animations all over the place, usually "pulse" animations.
These currently animate by waiting for a small but fixed amount of
time between each redisplay, which causes screen tearing by not
synchronizing with the vertical refresh. Frame synchronization works
diff --git a/etc/images/gud/README b/etc/images/gud/README
index 5edd99e2bf..c56c3fc0ee 100644
--- a/etc/images/gud/README
+++ b/etc/images/gud/README
@@ -13,10 +13,10 @@ License: GNU General Public License version 3 or later (see
COPYING)
Some icons are derived from Red Hat's Insight Debugger:
-<http://sourceware.org/insight/>
+<https://sourceware.org/insight/>
"Insight is a graphical user interface to GDB, the GNU Debugger"
-<http://sourceware.org/insight/aboutus.php>
+<https://sourceware.org/insight/aboutus.php>
"Insight is being released under the terms of the GNU General Public
License (GPL)"
diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt
index 5676a31c3a..025cf47274 100644
--- a/etc/publicsuffix.txt
+++ b/etc/publicsuffix.txt
@@ -7171,7 +7171,7 @@ org.zw
// newGTLDs
-// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2022-09-15T15:17:34Z
+// List of new gTLDs imported from
https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on
2022-10-29T15:16:24Z
// This list is auto-generated, don't edit it manually.
// aaa : 2015-02-26 American Automobile Association, Inc.
aaa
@@ -7341,7 +7341,7 @@ arab
// aramco : 2014-11-20 Aramco Services Company
aramco
-// archi : 2014-02-06 Afilias Limited
+// archi : 2014-02-06 Identity Digital Limited
archi
// army : 2014-03-06 Dog Beach, LLC
@@ -7389,7 +7389,7 @@ auto
// autos : 2014-01-09 XYZ.COM LLC
autos
-// avianca : 2015-01-08 Avianca Holdings S.A.
+// avianca : 2015-01-08 Avianca Inc.
avianca
// aws : 2015-06-25 AWS Registry LLC
@@ -7485,7 +7485,7 @@ best
// bestbuy : 2015-07-31 BBY Solutions, Inc.
bestbuy
-// bet : 2015-05-07 Afilias Limited
+// bet : 2015-05-07 Identity Digital Limited
bet
// bharti : 2014-01-09 Bharti Enterprises (Holding) Private Limited
@@ -7506,10 +7506,10 @@ bing
// bingo : 2014-12-04 Binky Moon, LLC
bingo
-// bio : 2014-03-06 Afilias Limited
+// bio : 2014-03-06 Identity Digital Limited
bio
-// black : 2014-01-16 Afilias Limited
+// black : 2014-01-16 Identity Digital Limited
black
// blackfriday : 2014-01-16 Registry Services, LLC
@@ -7524,7 +7524,7 @@ blog
// bloomberg : 2014-07-17 Bloomberg IP Holdings LLC
bloomberg
-// blue : 2013-11-07 Afilias Limited
+// blue : 2013-11-07 Identity Digital Limited
blue
// bms : 2014-10-30 Bristol-Myers Squibb Company
@@ -7596,9 +7596,6 @@ brother
// brussels : 2014-02-06 DNS.be vzw
brussels
-// bugatti : 2015-07-23 Bugatti International SA
-bugatti
-
// build : 2013-11-07 Plan Bee LLC
build
@@ -7641,9 +7638,6 @@ camera
// camp : 2013-11-07 Binky Moon, LLC
camp
-// cancerresearch : 2014-05-15 Australian Cancer Research Foundation
-cancerresearch
-
// canon : 2014-09-12 Canon Inc.
canon
@@ -7782,7 +7776,7 @@ claims
// cleaning : 2013-12-05 Binky Moon, LLC
cleaning
-// click : 2014-06-05 UNR Corp.
+// click : 2014-06-05 Internet Naming Company LLC
click
// clinic : 2014-03-20 Binky Moon, LLC
@@ -8436,7 +8430,7 @@ graphics
// gratis : 2014-03-20 Binky Moon, LLC
gratis
-// green : 2014-05-08 Afilias Limited
+// green : 2014-05-08 Identity Digital Limited
green
// gripe : 2014-03-06 Binky Moon, LLC
@@ -8751,7 +8745,7 @@ kia
// kids : 2021-08-13 DotKids Foundation Limited
kids
-// kim : 2013-09-23 Afilias Limited
+// kim : 2013-09-23 Identity Digital Limited
kim
// kinder : 2014-11-07 Ferrero Trading Lux S.A.
@@ -8856,7 +8850,7 @@ lego
// lexus : 2015-04-23 TOYOTA MOTOR CORPORATION
lexus
-// lgbt : 2014-05-08 Afilias Limited
+// lgbt : 2014-05-08 Identity Digital Limited
lgbt
// lidl : 2014-09-18 Schwarz Domains und Services GmbH & Co. KG
@@ -8904,7 +8898,7 @@ live
// living : 2015-07-30 Lifestyle Domain Holdings, Inc.
living
-// llc : 2017-12-14 Afilias Limited
+// llc : 2017-12-14 Identity Digital Limited
llc
// llp : 2019-08-26 Intercap Registry Inc.
@@ -8934,7 +8928,7 @@ london
// lotte : 2014-11-07 Lotte Holdings Co., Ltd.
lotte
-// lotto : 2014-04-10 Afilias Limited
+// lotto : 2014-04-10 Identity Digital Limited
lotto
// love : 2014-12-22 Merchant Law Group LLP
@@ -9282,7 +9276,7 @@ oracle
// orange : 2015-03-12 Orange Brand Services Limited
orange
-// organic : 2014-03-27 Afilias Limited
+// organic : 2014-03-27 Identity Digital Limited
organic
// origins : 2015-10-01 The Estée Lauder Companies Inc.
@@ -9330,7 +9324,7 @@ pay
// pccw : 2015-05-14 PCCW Enterprises Limited
pccw
-// pet : 2015-05-07 Afilias Limited
+// pet : 2015-05-07 Identity Digital Limited
pet
// pfizer : 2015-09-11 Pfizer Inc.
@@ -9378,7 +9372,7 @@ pin
// ping : 2015-06-11 Ping Registry Provider, Inc.
ping
-// pink : 2013-10-01 Afilias Limited
+// pink : 2013-10-01 Identity Digital Limited
pink
// pioneer : 2015-07-16 Pioneer Corporation
@@ -9408,7 +9402,7 @@ pnc
// pohl : 2014-06-23 Deutsche Vermögensberatung Aktiengesellschaft DVAG
pohl
-// poker : 2014-07-03 Afilias Limited
+// poker : 2014-07-03 Identity Digital Limited
poker
// politie : 2015-08-20 Politie Nederland
@@ -9441,7 +9435,7 @@ prof
// progressive : 2015-07-23 Progressive Casualty Insurance Company
progressive
-// promo : 2014-12-18 Afilias Limited
+// promo : 2014-12-18 Identity Digital Limited
promo
// properties : 2013-12-05 Binky Moon, LLC
@@ -9495,7 +9489,7 @@ realty
// recipes : 2013-10-17 Binky Moon, LLC
recipes
-// red : 2013-11-07 Afilias Limited
+// red : 2013-11-07 Identity Digital Limited
red
// redstone : 2014-10-31 Redstone Haute Couture Co., Ltd.
@@ -9744,7 +9738,7 @@ shell
// shia : 2014-09-04 Asia Green IT System Bilgisayar San. ve Tic. Ltd. Sti.
shia
-// shiksha : 2013-11-14 Afilias Limited
+// shiksha : 2013-11-14 Identity Digital Limited
shiksha
// shoes : 2013-10-02 Binky Moon, LLC
@@ -9777,7 +9771,7 @@ singles
// site : 2015-01-15 Radix FZC
site
-// ski : 2015-04-09 Afilias Limited
+// ski : 2015-04-09 Identity Digital Limited
ski
// skin : 2015-01-15 XYZ.COM LLC
@@ -10218,7 +10212,7 @@ wanggou
// watch : 2013-11-14 Binky Moon, LLC
watch
-// watches : 2014-12-22 Afilias Limited
+// watches : 2014-12-22 Identity Digital Limited
watches
// weather : 2015-01-08 International Business Machines Corporation
@@ -10353,7 +10347,7 @@ xin
// xn--5tzm5g : 2014-12-22 Global Website TLD Asia Limited
网站
-// xn--6frz82g : 2013-09-23 Afilias Limited
+// xn--6frz82g : 2013-09-23 Identity Digital Limited
移动
// xn--6qq986b3xl : 2013-09-13 Tycoon Treasure Limited
@@ -10660,6 +10654,10 @@ graphox.us
// Submitted by accesso Team <accessoecommerce@accesso.com>
*.devcdnaccesso.com
+// Acorn Labs : https://acorn.io
+// Submitted by Craig Jellick <domains@acorn.io>
+*.on-acorn.io
+
// Adobe : https://www.adobe.com/
// Submitted by Ian Boston <boston@adobe.com> and Lars Trieloff
<trieloff@adobe.com>
adobeaemcloud.com
@@ -10704,51 +10702,49 @@ altervista.org
// Submitted by Cyril <admin@alwaysdata.com>
alwaysdata.net
-// Amazon CloudFront : https://aws.amazon.com/cloudfront/
+// Amazon : https://www.amazon.com/
+// Submitted by AWS Security <psl-maintainers@amazon.com>
+// Subsections of Amazon/subsidiaries will appear until "concludes" tag
+
+// Amazon CloudFront
// Submitted by Donavan Miller <donavanm@amazon.com>
+// Reference: 54144616-fd49-4435-8535-19c6a601bdb3
cloudfront.net
-// Amazon Elastic Compute Cloud : https://aws.amazon.com/ec2/
+// Amazon EC2
// Submitted by Luke Wells <psl-maintainers@amazon.com>
+// Reference: 4c38fa71-58ac-4768-99e5-689c1767e537
*.compute.amazonaws.com
*.compute-1.amazonaws.com
*.compute.amazonaws.com.cn
us-east-1.amazonaws.com
-// Amazon Elastic Beanstalk : https://aws.amazon.com/elasticbeanstalk/
-// Submitted by Luke Wells <psl-maintainers@amazon.com>
-cn-north-1.eb.amazonaws.com.cn
-cn-northwest-1.eb.amazonaws.com.cn
-elasticbeanstalk.com
-ap-northeast-1.elasticbeanstalk.com
-ap-northeast-2.elasticbeanstalk.com
-ap-northeast-3.elasticbeanstalk.com
-ap-south-1.elasticbeanstalk.com
-ap-southeast-1.elasticbeanstalk.com
-ap-southeast-2.elasticbeanstalk.com
-ca-central-1.elasticbeanstalk.com
-eu-central-1.elasticbeanstalk.com
-eu-west-1.elasticbeanstalk.com
-eu-west-2.elasticbeanstalk.com
-eu-west-3.elasticbeanstalk.com
-sa-east-1.elasticbeanstalk.com
-us-east-1.elasticbeanstalk.com
-us-east-2.elasticbeanstalk.com
-us-gov-west-1.elasticbeanstalk.com
-us-west-1.elasticbeanstalk.com
-us-west-2.elasticbeanstalk.com
-
-// Amazon Elastic Load Balancing : https://aws.amazon.com/elasticloadbalancing/
-// Submitted by Luke Wells <psl-maintainers@amazon.com>
-*.elb.amazonaws.com
-*.elb.amazonaws.com.cn
-
-// Amazon Global Accelerator : https://aws.amazon.com/global-accelerator/
-// Submitted by Daniel Massaguer <psl-maintainers@amazon.com>
-awsglobalaccelerator.com
-
-// Amazon S3 : https://aws.amazon.com/s3/
+// Amazon S3
// Submitted by Luke Wells <psl-maintainers@amazon.com>
+// Reference: d068bd97-f0a9-4838-a6d8-954b622ef4ae
+s3.cn-north-1.amazonaws.com.cn
+s3.dualstack.ap-northeast-1.amazonaws.com
+s3.dualstack.ap-northeast-2.amazonaws.com
+s3.ap-northeast-2.amazonaws.com
+s3-website.ap-northeast-2.amazonaws.com
+s3.dualstack.ap-south-1.amazonaws.com
+s3.ap-south-1.amazonaws.com
+s3-website.ap-south-1.amazonaws.com
+s3.dualstack.ap-southeast-1.amazonaws.com
+s3.dualstack.ap-southeast-2.amazonaws.com
+s3.dualstack.ca-central-1.amazonaws.com
+s3.ca-central-1.amazonaws.com
+s3-website.ca-central-1.amazonaws.com
+s3.dualstack.eu-central-1.amazonaws.com
+s3.eu-central-1.amazonaws.com
+s3-website.eu-central-1.amazonaws.com
+s3.dualstack.eu-west-1.amazonaws.com
+s3.dualstack.eu-west-2.amazonaws.com
+s3.eu-west-2.amazonaws.com
+s3-website.eu-west-2.amazonaws.com
+s3.dualstack.eu-west-3.amazonaws.com
+s3.eu-west-3.amazonaws.com
+s3-website.eu-west-3.amazonaws.com
s3.amazonaws.com
s3-ap-northeast-1.amazonaws.com
s3-ap-northeast-2.amazonaws.com
@@ -10763,48 +10759,25 @@ s3-eu-west-3.amazonaws.com
s3-external-1.amazonaws.com
s3-fips-us-gov-west-1.amazonaws.com
s3-sa-east-1.amazonaws.com
-s3-us-gov-west-1.amazonaws.com
s3-us-east-2.amazonaws.com
+s3-us-gov-west-1.amazonaws.com
s3-us-west-1.amazonaws.com
s3-us-west-2.amazonaws.com
-s3.ap-northeast-2.amazonaws.com
-s3.ap-south-1.amazonaws.com
-s3.cn-north-1.amazonaws.com.cn
-s3.ca-central-1.amazonaws.com
-s3.eu-central-1.amazonaws.com
-s3.eu-west-2.amazonaws.com
-s3.eu-west-3.amazonaws.com
-s3.us-east-2.amazonaws.com
-s3.dualstack.ap-northeast-1.amazonaws.com
-s3.dualstack.ap-northeast-2.amazonaws.com
-s3.dualstack.ap-south-1.amazonaws.com
-s3.dualstack.ap-southeast-1.amazonaws.com
-s3.dualstack.ap-southeast-2.amazonaws.com
-s3.dualstack.ca-central-1.amazonaws.com
-s3.dualstack.eu-central-1.amazonaws.com
-s3.dualstack.eu-west-1.amazonaws.com
-s3.dualstack.eu-west-2.amazonaws.com
-s3.dualstack.eu-west-3.amazonaws.com
-s3.dualstack.sa-east-1.amazonaws.com
-s3.dualstack.us-east-1.amazonaws.com
-s3.dualstack.us-east-2.amazonaws.com
-s3-website-us-east-1.amazonaws.com
-s3-website-us-west-1.amazonaws.com
-s3-website-us-west-2.amazonaws.com
s3-website-ap-northeast-1.amazonaws.com
s3-website-ap-southeast-1.amazonaws.com
s3-website-ap-southeast-2.amazonaws.com
s3-website-eu-west-1.amazonaws.com
s3-website-sa-east-1.amazonaws.com
-s3-website.ap-northeast-2.amazonaws.com
-s3-website.ap-south-1.amazonaws.com
-s3-website.ca-central-1.amazonaws.com
-s3-website.eu-central-1.amazonaws.com
-s3-website.eu-west-2.amazonaws.com
-s3-website.eu-west-3.amazonaws.com
+s3-website-us-east-1.amazonaws.com
+s3-website-us-west-1.amazonaws.com
+s3-website-us-west-2.amazonaws.com
+s3.dualstack.sa-east-1.amazonaws.com
+s3.dualstack.us-east-1.amazonaws.com
+s3.dualstack.us-east-2.amazonaws.com
+s3.us-east-2.amazonaws.com
s3-website.us-east-2.amazonaws.com
-// AWS Cloud9 : https://aws.amazon.com/cloud9/
+// AWS Cloud9
// Submitted by: AWS Security <psl-maintainers@amazon.com>
// Reference: 2b6dfa9a-3a7f-4367-b2e7-0321e77c0d59
vfs.cloud9.af-south-1.amazonaws.com
@@ -10850,6 +10823,49 @@ webview-assets.cloud9.us-west-1.amazonaws.com
vfs.cloud9.us-west-2.amazonaws.com
webview-assets.cloud9.us-west-2.amazonaws.com
+// AWS Elastic Beanstalk
+// Submitted by Luke Wells <psl-maintainers@amazon.com>
+// Reference: aa202394-43a0-4857-b245-8db04549137e
+cn-north-1.eb.amazonaws.com.cn
+cn-northwest-1.eb.amazonaws.com.cn
+elasticbeanstalk.com
+ap-northeast-1.elasticbeanstalk.com
+ap-northeast-2.elasticbeanstalk.com
+ap-northeast-3.elasticbeanstalk.com
+ap-south-1.elasticbeanstalk.com
+ap-southeast-1.elasticbeanstalk.com
+ap-southeast-2.elasticbeanstalk.com
+ca-central-1.elasticbeanstalk.com
+eu-central-1.elasticbeanstalk.com
+eu-west-1.elasticbeanstalk.com
+eu-west-2.elasticbeanstalk.com
+eu-west-3.elasticbeanstalk.com
+sa-east-1.elasticbeanstalk.com
+us-east-1.elasticbeanstalk.com
+us-east-2.elasticbeanstalk.com
+us-gov-west-1.elasticbeanstalk.com
+us-west-1.elasticbeanstalk.com
+us-west-2.elasticbeanstalk.com
+
+// (AWS) Elastic Load Balancing
+// Submitted by Luke Wells <psl-maintainers@amazon.com>
+// Reference: 12a3d528-1bac-4433-a359-a395867ffed2
+*.elb.amazonaws.com.cn
+*.elb.amazonaws.com
+
+// AWS Global Accelerator
+// Submitted by Daniel Massaguer <psl-maintainers@amazon.com>
+// Reference: d916759d-a08b-4241-b536-4db887383a6a
+awsglobalaccelerator.com
+
+// eero
+// Submitted by Yue Kang <eero-dynamic-dns@amazon.com>
+// Reference: 264afe70-f62c-4c02-8ab9-b5281ed24461
+eero.online
+eero-stage.online
+
+// concludes Amazon
+
// Amune : https://amune.org/
// Submitted by Team Amune <cert@amune.org>
t3l3p0rt.net
@@ -11745,11 +11761,6 @@ e4.cz
easypanel.app
easypanel.host
-// eero : https://eero.com/
-// Submitted by Yue Kang <eero-dynamic-dns@amazon.com>
-eero.online
-eero-stage.online
-
// Elementor : Elementor Ltd.
// Submitted by Anton Barkan <antonb@elementor.com>
elementor.cloud
@@ -11963,6 +11974,10 @@ a.ssl.fastly.net
b.ssl.fastly.net
global.ssl.fastly.net
+// Fastmail : https://www.fastmail.com/
+// Submitted by Marc Bradshaw <marc@fastmailteam.com>
+*.user.fm
+
// FASTVPS EESTI OU : https://fastvps.ru/
// Submitted by Likhachev Vasiliy <lihachev@fastvps.ru>
fastvps-server.com
@@ -12973,25 +12988,6 @@ cust.retrosnub.co.uk
// Submitted by Paulus Schoutsen <infra@nabucasa.com>
ui.nabu.casa
-// Names.of.London : https://names.of.london/
-// Submitted by James Stevens <registry[at]names.of.london> or
<publiclist[at]jrcs.net>
-pony.club
-of.fashion
-in.london
-of.london
-from.marketing
-with.marketing
-for.men
-repair.men
-and.mom
-for.mom
-for.one
-under.one
-for.sale
-that.win
-from.work
-to.work
-
// Net at Work Gmbh : https://www.netatwork.de
// Submitted by Jan Jaeschke <jan.jaeschke@netatwork.de>
cloud.nospamproxy.com
@@ -13188,7 +13184,26 @@ omniwe.site
// One.com: https://www.one.com/
// Submitted by Jacob Bunk Nielsen <jbn@one.com>
+123hjemmeside.dk
+123hjemmeside.no
+123homepage.it
+123kotisivu.fi
+123minsida.se
+123miweb.es
+123paginaweb.pt
+123sait.ru
+123siteweb.fr
+123webseite.at
+123webseite.de
+123website.be
+123website.ch
+123website.lu
+123website.nl
service.one
+simplesite.com
+simplesite.com.br
+simplesite.gr
+simplesite.pl
// One Fold Media : http://www.onefoldmedia.com/
// Submitted by Eddie Jones <eddie@onefoldmedia.com>
@@ -13457,7 +13472,9 @@ app.render.com
onrender.com
// Repl.it : https://repl.it
-// Submitted by Mason Clayton <mason@repl.it>
+// Submitted by Lincoln Bergeson <lincoln@replit.com>
+firewalledreplit.co
+id.firewalledreplit.co
repl.co
id.repl.co
repl.run
diff --git a/etc/srecode/ede-autoconf.srt b/etc/srecode/ede-autoconf.srt
index ecca7afd00..51656eb73c 100644
--- a/etc/srecode/ede-autoconf.srt
+++ b/etc/srecode/ede-autoconf.srt
@@ -38,7 +38,7 @@ template ede-empty :project
{{comment_prefix}} by EDE when this file is updated.
{{comment_prefix}}
{{comment_prefix}} EDE is the Emacs Development Environment.
-{{comment_prefix}} http://cedet.sourceforge.net/ede.shtml
+{{comment_prefix}} https://cedet.sourceforge.net/ede.shtml
{{comment_prefix}}
{{comment_prefix}} Process this file with autoconf to produce a configure
script
diff --git a/etc/srecode/ede-make.srt b/etc/srecode/ede-make.srt
index cde1690f54..c01054e042 100644
--- a/etc/srecode/ede-make.srt
+++ b/etc/srecode/ede-make.srt
@@ -34,7 +34,7 @@ template ede-empty :file :project
#
# DO NOT MODIFY THIS FILE OR YOUR CHANGES MAY BE LOST.
# EDE is the Emacs Development Environment.
-# http://cedet.sourceforge.net/ede.shtml
+# https://cedet.sourceforge.net/ede.shtml
#
----
@@ -58,7 +58,7 @@ template ede-empty :file
#
# DO NOT MODIFY THIS FILE OR YOUR CHANGES MAY BE LOST.
# EDE is the Emacs Development Environment.
-# http://cedet.sourceforge.net/ede.shtml
+# https://cedet.sourceforge.net/ede.shtml
ARDUINO_DIR = {{ARDUINO_HOME}}
diff --git a/etc/themes/adwaita-theme.el b/etc/themes/adwaita-theme.el
index ba83a0578c..6ad8405559 100644
--- a/etc/themes/adwaita-theme.el
+++ b/etc/themes/adwaita-theme.el
@@ -21,10 +21,13 @@
;;; Code:
+;;;###theme-autoload
(deftheme adwaita
"Face colors similar to the default theme of Gnome 3 (Adwaita).
The colors are chosen to match Adwaita window decorations and the
-default look of the Gnome 3 desktop.")
+default look of the Gnome 3 desktop."
+ :background-mode 'light
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
diff --git a/etc/themes/deeper-blue-theme.el b/etc/themes/deeper-blue-theme.el
index 8f19147f91..48ed9ba061 100644
--- a/etc/themes/deeper-blue-theme.el
+++ b/etc/themes/deeper-blue-theme.el
@@ -21,8 +21,11 @@
;;; Code:
+;;;###theme-autoload
(deftheme deeper-blue
- "Face colors using a deep blue background.")
+ "Face colors using a deep blue background."
+ :background-mode 'dark
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el
index d53c075d92..c9d73983b5 100644
--- a/etc/themes/dichromacy-theme.el
+++ b/etc/themes/dichromacy-theme.el
@@ -21,6 +21,7 @@
;;; Code:
+;;;###theme-autoload
(deftheme dichromacy
"Face colors suitable for red/green color-blind users.
The color palette is from B. Wong, Nature Methods 8, 441 (2011).
@@ -28,7 +29,9 @@ It is intended to provide good variability while being easily
differentiated by individuals with protanopia or deuteranopia.
Basic, Font Lock, Isearch, Gnus, Message, Flyspell, and
-Ansi-Color faces are included.")
+Ansi-Color faces are included."
+ :background-mode 'light
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89)))
(orange "#e69f00")
@@ -36,7 +39,7 @@ Ansi-Color faces are included.")
(bluegreen "#009e73")
(yellow "#f8ec59")
(blue "#0072b2")
- (vermillion "#d55e00")
+ (vermilion "#d55e00")
(redpurple "#cc79a7")
(bluegray "#848ea9"))
(custom-theme-set-faces
@@ -48,9 +51,9 @@ Ansi-Color faces are included.")
`(highlight ((,class (:foreground ,blue :background "#e5e5e5"))))
`(region ((,class (:foreground unspecified :background ,yellow))))
`(secondary-selection ((,class (:background "#e5e5e5"))))
- `(isearch ((,class (:foreground "white" :background ,vermillion))))
+ `(isearch ((,class (:foreground "white" :background ,vermilion))))
`(lazy-highlight ((,class (:foreground "white" :background ,redpurple))))
- `(trailing-whitespace ((,class (:background ,vermillion))))
+ `(trailing-whitespace ((,class (:background ,vermilion))))
;; Mode line faces
`(mode-line ((,class (:box (:line-width -1 :style released-button)
:background "#e5e5e5" :foreground "black"))))
@@ -59,17 +62,17 @@ Ansi-Color faces are included.")
:foreground "black"))))
;; Escape and prompt faces
`(minibuffer-prompt ((,class (:weight bold :foreground ,blue))))
- `(escape-glyph ((,class (:foreground ,vermillion))))
- `(homoglyph ((,class (:foreground ,vermillion))))
+ `(escape-glyph ((,class (:foreground ,vermilion))))
+ `(homoglyph ((,class (:foreground ,vermilion))))
`(error ((,class (:weight bold :slant italic
- :foreground ,vermillion))))
+ :foreground ,vermilion))))
`(warning ((,class (:foreground ,orange))))
`(success ((,class (:foreground ,bluegreen))))
;; Font lock faces
`(font-lock-builtin-face ((,class (:foreground ,blue))))
`(font-lock-comment-face ((,class (:slant italic :foreground ,bluegreen))))
- `(font-lock-constant-face ((,class (:weight bold :foreground ,vermillion))))
- `(font-lock-function-name-face ((,class (:foreground ,vermillion))))
+ `(font-lock-constant-face ((,class (:weight bold :foreground ,vermilion))))
+ `(font-lock-function-name-face ((,class (:foreground ,vermilion))))
`(font-lock-keyword-face ((,class (:weight bold :foreground ,skyblue))))
`(font-lock-string-face ((,class (:foreground ,bluegray))))
`(font-lock-type-face ((,class (:weight bold :foreground ,blue))))
@@ -78,8 +81,8 @@ Ansi-Color faces are included.")
`(link ((,class (:underline t :foreground ,blue))))
`(link-visited ((,class (:underline t :foreground ,redpurple))))
;; Gnus faces
- `(gnus-group-news-1 ((,class (:weight bold :foreground ,vermillion))))
- `(gnus-group-news-1-low ((,class (:foreground ,vermillion))))
+ `(gnus-group-news-1 ((,class (:weight bold :foreground ,vermilion))))
+ `(gnus-group-news-1-low ((,class (:foreground ,vermilion))))
`(gnus-group-news-2 ((,class (:weight bold :foreground ,orange))))
`(gnus-group-news-2-low ((,class (:foreground ,orange))))
`(gnus-group-news-3 ((,class (:weight bold :foreground ,skyblue))))
@@ -89,8 +92,8 @@ Ansi-Color faces are included.")
`(gnus-group-news-5 ((,class (:weight bold :foreground ,blue))))
`(gnus-group-news-5-low ((,class (:foreground ,blue))))
`(gnus-group-news-low ((,class (:foreground ,bluegreen))))
- `(gnus-group-mail-1 ((,class (:weight bold :foreground ,vermillion))))
- `(gnus-group-mail-1-low ((,class (:foreground ,vermillion))))
+ `(gnus-group-mail-1 ((,class (:weight bold :foreground ,vermilion))))
+ `(gnus-group-mail-1-low ((,class (:foreground ,vermilion))))
`(gnus-group-mail-2 ((,class (:weight bold :foreground ,orange))))
`(gnus-group-mail-2-low ((,class (:foreground ,orange))))
`(gnus-group-mail-3 ((,class (:weight bold :foreground ,skyblue))))
@@ -100,13 +103,13 @@ Ansi-Color faces are included.")
`(gnus-header-from ((,class (:weight bold :foreground ,blue))))
`(gnus-header-subject ((,class (:foreground ,orange))))
`(gnus-header-name ((,class (:foreground ,skyblue))))
- `(gnus-header-newsgroups ((,class (:foreground ,vermillion))))
+ `(gnus-header-newsgroups ((,class (:foreground ,vermilion))))
;; Image-Dired
- `(image-dired-thumb-flagged ((,class (:background ,vermillion))))
+ `(image-dired-thumb-flagged ((,class (:background ,vermilion))))
`(image-dired-thumb-mark ((,class (:background ,orange))))
;; Message faces
`(message-header-name ((,class (:foreground ,skyblue))))
- `(message-header-cc ((,class (:foreground ,vermillion))))
+ `(message-header-cc ((,class (:foreground ,vermilion))))
`(message-header-other ((,class (:foreground ,bluegreen))))
`(message-header-subject ((,class (:foreground ,orange))))
`(message-header-to ((,class (:weight bold :foreground ,blue))))
@@ -119,8 +122,8 @@ Ansi-Color faces are included.")
:slant unspecified :underline ,redpurple))))
;; ANSI color
`(ansi-color-black ((,class (:background "black" :foreground "black"))))
- `(ansi-color-red ((,class (:background ,vermillion
- :foreground ,vermillion))))
+ `(ansi-color-red ((,class (:background ,vermilion
+ :foreground ,vermilion))))
`(ansi-color-green ((,class (:background ,bluegreen
:foreground ,bluegreen))))
`(ansi-color-yellow ((,class (:background ,yellow :foreground ,yellow))))
@@ -131,8 +134,8 @@ Ansi-Color faces are included.")
`(ansi-color-white ((,class (:background "gray90" :foreground "gray90"))))
`(ansi-color-bright-black ((,class (:background "black"
:foreground "black"))))
- `(ansi-color-bright-red ((,class (:background ,vermillion
- :foreground ,vermillion))))
+ `(ansi-color-bright-red ((,class (:background ,vermilion
+ :foreground ,vermilion))))
`(ansi-color-bright-green ((,class (:background ,bluegreen
:foreground ,bluegreen))))
`(ansi-color-bright-yellow ((,class (:background ,yellow
diff --git a/etc/themes/leuven-dark-theme.el b/etc/themes/leuven-dark-theme.el
index 0e162c8bab..08978a2668 100644
--- a/etc/themes/leuven-dark-theme.el
+++ b/etc/themes/leuven-dark-theme.el
@@ -5,7 +5,7 @@
;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")>
;; Contributor: Thibault Polge <(concat "thibault" at-sign "thb.lt")>
;; URL: https://github.com/fniessen/emacs-leuven-dark-theme
-;; Version: 20220202.1126
+;; Version: 20221010.1208
;; Keywords: color theme
;; This file is part of GNU Emacs.
@@ -93,11 +93,15 @@ CONTROL can be a number, nil, or t. When t, use
DEFAULT-HEIGHT."
;;; Theme Faces.
+;;;###theme-autoload
(deftheme leuven-dark
"Face colors with a light background.
Basic, Font Lock, Isearch, Gnus, Message, Org mode, Diff, Ediff,
Flyspell, Semantic, and Ansi-Color faces are included -- and much
-more...")
+more..."
+ :background-mode 'dark
+ :family 'leuven
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89)))
diff --git a/etc/themes/leuven-theme.el b/etc/themes/leuven-theme.el
index d9a8d5391a..e712a79adf 100644
--- a/etc/themes/leuven-theme.el
+++ b/etc/themes/leuven-theme.el
@@ -4,7 +4,7 @@
;; Author: Fabrice Niessen <(concat "fniessen" at-sign "pirilampo.org")>
;; URL: https://github.com/fniessen/emacs-leuven-theme
-;; Version: 20200513.1928
+;; Version: 20221010.1209
;; Keywords: color theme
;; This file is part of GNU Emacs.
@@ -74,11 +74,15 @@ CONTROL can be a number, nil, or t. When t, use
DEFAULT-HEIGHT."
;;; Theme Faces.
+;;;###theme-autoload
(deftheme leuven
"Face colors with a light background.
Basic, Font Lock, Isearch, Gnus, Message, Org mode, Diff, Ediff,
Flyspell, Semantic, and Ansi-Color faces are included -- and much
-more...")
+more..."
+ :background-mode 'light
+ :kind 'color-scheme
+ :family 'leuven)
(let ((class '((class color) (min-colors 89)))
diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el
index eeca46210c..808fcbfeb2 100644
--- a/etc/themes/light-blue-theme.el
+++ b/etc/themes/light-blue-theme.el
@@ -26,8 +26,11 @@
;;; Code:
+;;;###theme-autoload
(deftheme light-blue
- "Face colors utilizing a light blue background.")
+ "Face colors utilizing a light blue background."
+ :background-mode 'light
+ :kind 'color-scheme)
(make-obsolete 'light-blue nil "29.1")
diff --git a/etc/themes/manoj-dark-theme.el b/etc/themes/manoj-dark-theme.el
index af5576386c..f9aaa97c25 100644
--- a/etc/themes/manoj-dark-theme.el
+++ b/etc/themes/manoj-dark-theme.el
@@ -64,10 +64,13 @@
;;; Code:
+;;;###theme-autoload
(deftheme manoj-dark
"Very high contrast faces with a black background.
This theme avoids subtle color variations, while avoiding the
-jarring angry fruit salad look to reduce eye fatigue.")
+jarring angry fruit salad look to reduce eye fatigue."
+ :background-mode 'dark
+ :kind 'color-scheme)
(custom-theme-set-faces
'manoj-dark
diff --git a/etc/themes/misterioso-theme.el b/etc/themes/misterioso-theme.el
index 55186384ad..3fd6cdb5af 100644
--- a/etc/themes/misterioso-theme.el
+++ b/etc/themes/misterioso-theme.el
@@ -21,8 +21,11 @@
;;; Code:
+;;;###theme-autoload
(deftheme misterioso
- "Predominantly blue/cyan faces on a dark cyan background.")
+ "Predominantly blue/cyan faces on a dark cyan background."
+ :background-mode 'dark
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
diff --git a/etc/themes/modus-operandi-theme.el
b/etc/themes/modus-operandi-theme.el
index 6e609c0803..6ea92f8559 100644
--- a/etc/themes/modus-operandi-theme.el
+++ b/etc/themes/modus-operandi-theme.el
@@ -6,7 +6,7 @@
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
-;; Version: 2.7.1
+;; Version: 3.0.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
@@ -71,4 +71,7 @@ which corresponds to a minimum contrast in relative luminance
of
(provide-theme 'modus-operandi))
+;;;###theme-autoload
+(put 'modus-operandi 'theme-properties '(:background-mode light :kind
color-scheme :family modus))
+
;;; modus-operandi-theme.el ends here
diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el
index d5e1b0a120..a9d0d53cba 100644
--- a/etc/themes/modus-themes.el
+++ b/etc/themes/modus-themes.el
@@ -6,7 +6,7 @@
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
-;; Version: 2.7.1
+;; Version: 3.0.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
@@ -88,7 +88,7 @@
(require 'subr-x))
(defgroup modus-themes ()
- "Options for `modus-operandi', `modus-vivendi'.
+ "Options for `modus-operandi', `modus-vivendi' themes.
The Modus themes conform with the WCAG AAA standard for color
contrast between background and foreground combinations (a
minimum contrast of 7:1---the highest standard of its kind). The
@@ -103,13 +103,13 @@ cover the blue-cyan-magenta side of the spectrum."
:tag "Modus Themes")
(defgroup modus-themes-faces ()
- "Faces defined by `modus-operandi' and `modus-vivendi'."
+ "Faces defined by `modus-operandi' and `modus-vivendi' themes."
:group 'modus-themes
:link '(info-link "(modus-themes) Top")
:prefix "modus-themes-"
:tag "Modus Themes Faces")
-(defvar modus-themes--version "2.7.0"
+(defvar modus-themes--version "3.0.0"
"Current version of the Modus themes.
The version either is the last tagged release, such as '1.0.0',
@@ -123,10 +123,7 @@ those would count as part of '1.1.0-dev'.")
If optional INSERT argument is provided from Lisp or as a prefix
argument, insert the `modus-themes--version' at point."
(interactive "P")
- (if-let ((version modus-themes--version)
- ((or insert current-prefix-arg)))
- (insert version)
- (message version)))
+ (funcall (if insert 'insert 'message) modus-themes--version))
;;;###autoload
(defun modus-themes-report-bug ()
@@ -1364,26 +1361,6 @@ The actual styling of the face is done by
`modus-themes-faces'."
The actual styling of the face is done by `modus-themes-faces'."
:group 'modus-themes-faces)
-(define-obsolete-face-alias
- 'modus-themes-completion-standard-first-match
- 'modus-themes-completion-selected
- "2.2.0")
-
-(define-obsolete-face-alias
- 'modus-themes-completion-standard-selected
- 'modus-themes-completion-selected
- "2.2.0")
-
-(define-obsolete-face-alias
- 'modus-themes-completion-extra-selected
- 'modus-themes-completion-selected
- "2.2.0")
-
-(define-obsolete-face-alias
- 'modus-themes-completion-key-binding
- 'modus-themes-key-binding
- "2.2.0")
-
(defface modus-themes-completion-selected nil
"Face for current selection in completion UIs.
The actual styling of the face is done by `modus-themes-faces'."
@@ -1934,20 +1911,22 @@ For example:
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Org agenda"))
-(defcustom modus-themes-fringes nil
- "Define the visibility of fringes.
+(defcustom modus-themes-fringes 'subtle
+ "Control the visibility of fringes.
+
+When the value is nil, do not apply a distinct background color.
-Nil means the fringes have no background color. Option `subtle'
-will apply a grayscale value that is visible yet close to the
-main buffer background color. Option `intense' will use a more
-pronounced grayscale value."
+With a value of `subtle' use a gray background color that is
+visible yet close to the main background color.
+
+With `intense' use a more pronounced gray background color."
:group 'modus-themes
- :package-version '(modus-themes . "1.0.0")
- :version "28.1"
+ :package-version '(modus-themes . "3.0.0")
+ :version "29.1"
:type '(choice
- (const :format "[%v] %t\n" :tag "No visible fringes (default)" nil)
- (const :format "[%v] %t\n" :tag "Subtle grayscale background" subtle)
- (const :format "[%v] %t\n" :tag "Intense grayscale background"
intense))
+ (const :format "[%v] %t\n" :tag "No visible fringes" nil)
+ (const :format "[%v] %t\n" :tag "Subtle gray background" subtle)
+ (const :format "[%v] %t\n" :tag "Intense gray background" intense))
:set #'modus-themes--set-option
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Fringes"))
@@ -2212,13 +2191,16 @@ interest of optimizing for such a use-case."
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Diffs"))
-(defcustom modus-themes-completions nil
+(defcustom modus-themes-completions
+ '((selection . (intense))
+ (popup . (intense)))
"Control the style of completion user interfaces.
This affects Company, Corfu, Flx, Helm, Icomplete/Fido, Ido, Ivy,
-Mct, Orderless, Selectrum, Vertico. The value is an alist that
-takes the form of a (key . properties) combination. Here is a
-sample, followed by a description of the particularities:
+Orderless, Selectrum, Vertico. The value is an alist that takes
+the form of a (KEY . PROPERTIES) combination. KEY is a symbol,
+while PROPERTIES is a list. Here is a sample, followed by a
+description of the particularities:
(setq modus-themes-completions
(quote ((matches . (extrabold background intense))
@@ -2226,10 +2208,11 @@ sample, followed by a description of the
particularities:
(popup . (accented)))))
The `matches' key refers to the highlighted characters that
-correspond to the user's input. By default (nil or an empty
-list), they have a bold weight and a colored foreground. The
-list of properties may include any of the following symbols
-regardless of the order they may appear in:
+correspond to the user's input. When its properties are nil or
+an empty list, matching characters in the user interface will
+have a bold weight and a colored foreground. The list of
+properties may include any of the following symbols regardless of
+the order they may appear in:
- `background' to add a background color;
@@ -2246,10 +2229,10 @@ regardless of the order they may appear in:
that bold will be used.
The `selection' key applies to the current line or currently
-matched candidate, depending on the specifics of the User
-Interface. By default (nil or an empty list), it has a subtle
-gray background, a bold weight, and the base foreground value
-for the text. The list of properties it accepts is as
+matched candidate, depending on the specifics of the user
+interface. When its properties are nil or an empty list, it has
+a subtle gray background, a bold weight, and the base foreground
+value for the text. The list of properties it accepts is as
follows (order is not significant):
- `accented' to make the background colorful instead of gray;
@@ -2268,7 +2251,11 @@ follows (order is not significant):
variable `modus-themes-weights'. The absence of a weight means
that bold will be used.
-The `popup' key takes the same values as `selection'.
+The `popup' key takes the same values as `selection'. The only
+difference is that it applies specifically to user interfaces
+that display an inline popup and thus have slightly different
+styling requirements than the minibuffer. The two prominent
+packages are `company' and `corfu'.
Apart from specifying each key separately, a fallback list is
accepted. This is only useful when the desired aesthetic is the
@@ -2290,22 +2277,14 @@ the corresponding key is simply ignored (`matches' does
not have
`accented' and `text-also', while `selection' and `popup' do not
have `background').
-A concise expression of those associations can be written as
-follows, where the `car' is always the key and the `cdr' is the
-list of properties (whatever order they may appear in):
-
- (setq modus-themes-completions
- (quote ((matches extrabold background intense)
- (selection semibold accented intense)
- (popup accented))))
-
Check the manual for tweaking `bold' and `italic' faces: Info
node `(modus-themes) Configure bold and italic faces'.
-Also refer to the Orderless documentation for its intersection
-with Company (if you choose to use those in tandem)."
+Also refer to the documentation of the `orderless' package for
+its intersection with `company' (if you choose to use those in
+tandem)."
:group 'modus-themes
- :package-version '(modus-themes . "2.3.0")
+ :package-version '(modus-themes . "3.0.0")
:version "29.1"
:type `(set
(cons :tag "Matches"
@@ -2420,11 +2399,11 @@ In user configuration files the form may look like this:
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Command prompts"))
-(defcustom modus-themes-hl-line nil
- "Control the current line highlight of HL-line mode.
+(defcustom modus-themes-hl-line '(intense)
+ "Control the current line highlight of `hl-line-mode'.
The value is a list of properties, each designated by a symbol.
-The default (a nil value or an empty list) is a subtle gray
+With a nil value, or an empty list, the style is a subtle gray
background color.
The property `accented' changes the background to a colored
@@ -2450,11 +2429,12 @@ In user configuration files the form may look like this:
(setq modus-themes-hl-line (quote (underline accented)))
-Set `x-underline-at-descent-line' to a non-nil value for better
-results with underlines."
+Set `x-underline-at-descent-line' to a non-nil value so that the
+placement of the underline coincides with the lower boundary of
+the colored background."
:group 'modus-themes
- :package-version '(modus-themes . "1.5.0")
- :version "28.1"
+ :package-version '(modus-themes . "3.0.0")
+ :version "29.1"
:type '(set :tag "Properties" :greedy t
(const :tag "Colored background" accented)
(const :tag "Underline" underline)
@@ -2522,8 +2502,6 @@ Also check the variables `org-hide-emphasis-markers',
:initialize #'custom-initialize-default
:link '(info-link "(modus-themes) Markup"))
-(make-obsolete 'modus-themes-intense-markup 'modus-themes-markup "2.1.0")
-
(defcustom modus-themes-paren-match nil
"Control the style of matching parentheses or delimiters.
@@ -3225,11 +3203,6 @@ an alternative to the default value."
"Get cdr of KEY in ALIST."
(cdr (assoc key alist)))
-(define-obsolete-variable-alias
- 'modus-themes--heading-weights
- 'modus-themes-weights
- "2.1.0")
-
(defconst modus-themes-weights
'( thin ultralight extralight light semilight regular medium
semibold bold heavy extrabold ultrabold)
@@ -3582,9 +3555,6 @@ foreground unspecified."
(list deuteran)
(list main)))
-(make-obsolete 'modus-themes--completion 'modus-themes--completion-line
"2.3.0")
-(make-obsolete 'modus-themes--completion 'modus-themes--completion-match
"2.3.0")
-
(defun modus-themes--completion-line (key bg fg bgintense fgintense &optional
bgaccent bgaccentintense)
"Styles for `modus-themes-completions'.
KEY is the key of a cons cell. BG and FG are the main colors.
@@ -4309,8 +4279,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
magenta-subtle-bg magenta-intense))))
`(modus-themes-completion-match-1
((,class ,@(modus-themes--completion-match
- 'matches bg-special-faint-cold cyan
- cyan-subtle-bg cyan-intense))))
+ 'matches bg-special-faint-cold blue
+ blue-subtle-bg blue-intense))))
`(modus-themes-completion-match-2
((,class ,@(modus-themes--completion-match
'matches bg-special-faint-mild green
@@ -4798,9 +4768,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(consult-line-number-prefix ((,class :foreground ,fg-unfocused)))
`(consult-narrow-indicator ((,class :foreground ,magenta-alt)))
`(consult-preview-cursor ((,class :inherit modus-themes-intense-blue)))
- `(consult-preview-error ((,class :inherit modus-themes-intense-red)))
`(consult-preview-insertion ((,class :inherit modus-themes-special-warm)))
- `(consult-preview-line ((,class :background ,bg-hl-alt-intense)))
;;;;; corfu
`(corfu-current ((,class :inherit modus-themes-completion-selected-popup)))
`(corfu-bar ((,class :background ,fg-alt)))
@@ -4928,16 +4896,12 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; diff-hl
`(diff-hl-change ((,class :inherit modus-themes-fringe-yellow)))
`(diff-hl-delete ((,class :inherit modus-themes-fringe-red)))
- `(diff-hl-dired-change ((,class :inherit diff-hl-change)))
- `(diff-hl-dired-delete ((,class :inherit diff-hl-delete)))
- `(diff-hl-dired-ignored ((,class :inherit dired-ignored)))
- `(diff-hl-dired-insert ((,class :inherit diff-hl-insert)))
- `(diff-hl-dired-unknown ((,class :inherit dired-ignored)))
`(diff-hl-insert ((,class :inherit modus-themes-grue-background-active)))
`(diff-hl-reverted-hunk-highlight ((,class :background ,fg-main
:foreground ,bg-main)))
;;;;; diff-mode
`(diff-added ((,class :inherit modus-themes-diff-added)))
`(diff-changed ((,class :inherit modus-themes-diff-changed :extend t)))
+ `(diff-changed-unspecified ((,class :inherit diff-changed)))
`(diff-context ((,class ,@(unless (eq modus-themes-diffs 'bg-only) (list
:foreground fg-unfocused)))))
`(diff-error ((,class :inherit modus-themes-intense-red)))
`(diff-file-header ((,class :inherit (bold diff-header))))
@@ -5741,17 +5705,43 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;; HACK 2022-06-23: The :inverse-video prevents hl-line-mode from
;; overriding the background. Such an override really defeats the
;; purpose of setting those highlights.
- `(hi-aquamarine ((,class :background ,bg-main :foreground ,cyan
:inverse-video t)))
+ ;;
+ ;; NOTE 2022-10-04: We do not use the ,class here but instead
+ ;; hardcode color values. We have to do this as the themes lack
+ ;; entries in their palette for such an edge case. Defining those
+ ;; entries is not appropriate.
+ `(hi-aquamarine ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#227f9f" :inverse-video
t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#66cbdc" :inverse-video
t)))
`(hi-black-b ((,class :inverse-video t)))
`(hi-black-hb ((,class :background ,bg-main :foreground ,fg-alt
:inverse-video t)))
- `(hi-blue ((,class :background ,bg-main :foreground ,blue-alt
:inverse-video t)))
+ `(hi-blue ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#3366dd" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#aaccff" :inverse-video t)))
`(hi-blue-b ((,class :inherit (bold hi-blue))))
- `(hi-green ((,class :background ,bg-main :foreground ,green :inverse-video
t)))
+ `(hi-green ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#008a00" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#66dd66" :inverse-video t)))
`(hi-green-b ((,class :inherit (bold hi-green))))
- `(hi-pink ((,class :background ,bg-main :foreground ,magenta
:inverse-video t)))
- `(hi-red-b ((,class :inherit bold :background ,bg-main :foreground ,red
:inverse-video t)))
- `(hi-salmon ((,class :background ,bg-main :foreground ,red-alt-faint
:inverse-video t)))
- `(hi-yellow ((,class :background ,bg-main :foreground ,yellow-alt
:inverse-video t)))
+ `(hi-pink ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#bd30aa" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#ff88ee" :inverse-video t)))
+ `(hi-red-b ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#dd0000" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#f06666" :inverse-video t)))
+ `(hi-salmon ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#bf555a" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#e08a50" :inverse-video t)))
+ `(hi-yellow ((((class color) (min-colors 88) (background light))
+ :background "white" :foreground "#af6400" :inverse-video t)
+ (((class color) (min-colors 88) (background dark))
+ :background "black" :foreground "#faea00" :inverse-video t)))
`(highlight ((,class ,@(if modus-themes-intense-mouseovers
(list :background blue-intense-bg :foreground
fg-main)
(list :background cyan-subtle-bg :foreground
fg-main)))))
@@ -5800,6 +5790,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(iflipb-other-buffer-face ((,class :inherit shadow)))
;;;;; image-dired
`(image-dired-thumb-flagged ((,class :background ,red-intense-bg)))
+ `(image-dired-thumb-header-file-name ((,class :inherit bold)))
+ `(image-dired-thumb-header-file-size ((,class :foreground ,blue-active)))
`(image-dired-thumb-mark ((,class :inherit
modus-themes-grue-background-intense)))
;;;;; imenu-list
`(imenu-list-entry-face-0 ((,class :foreground ,cyan)))
@@ -6485,6 +6477,8 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(nxml-prolog-keyword ((,class :inherit font-lock-keyword-face)))
`(nxml-ref ((,class :inherit modus-themes-bold :foreground
,fg-special-mild)))
`(rng-error ((,class :inherit error)))
+;;;;; olivetti
+ `(olivetti-fringe ((,class :background ,bg-main)))
;;;;; orderless
`(orderless-match-face-0 ((,class :inherit
modus-themes-completion-match-0)))
`(orderless-match-face-1 ((,class :inherit
modus-themes-completion-match-1)))
@@ -7109,17 +7103,13 @@ by virtue of calling either of
`modus-themes-load-operandi' and
;;;;; table (built-in table.el)
`(table-cell ((,class :background ,blue-nuanced-bg)))
;;;;; telega
- ;; FIXME 2021-03-28: Some aspects of `telega' are not fully
- ;; supported or have not been tested thoroughly. Please understand
- ;; that I do not use that service because it requires a smartphone
- ;; and I have none. Help with testing is appreciated.
`(telega-button ((,class :box t :foreground ,blue)))
`(telega-button-active ((,class :box ,blue-intense-bg :background
,blue-intense-bg :foreground ,fg-main)))
`(telega-button-highlight ((,class :inherit modus-themes-subtle-magenta)))
`(telega-chat-prompt ((,class :inherit bold)))
- `(telega-entity-type-code ((,class :inherit modus-themes-fixed-pitch)))
+ `(telega-entity-type-code ((,class :inherit modus-themes-markup-verbatim)))
`(telega-entity-type-mention ((,class :foreground ,cyan)))
- `(telega-entity-type-pre ((,class :inherit modus-themes-fixed-pitch)))
+ `(telega-entity-type-pre ((,class :inherit modus-themes-markup-code)))
`(telega-entity-type-spoiler ((,class :background ,fg-main :foreground
,fg-main)))
`(telega-msg-heading ((,class :background ,bg-alt)))
`(telega-msg-self-title ((,class :inherit bold)))
@@ -7168,7 +7158,7 @@ by virtue of calling either of
`modus-themes-load-operandi' and
`(term-color-yellow ((,class :background ,yellow :foreground ,yellow)))
`(term-underline ((,class :underline t)))
;;;;; textsec
- `(textsec-suspicious ((,class :inherit modus-themes-refine-red)))
+ `(textsec-suspicious (()))
;;;;; tomatinho
`(tomatinho-ok-face ((,class :foreground ,blue-intense)))
`(tomatinho-pause-face ((,class :foreground ,yellow-intense)))
diff --git a/etc/themes/modus-vivendi-theme.el
b/etc/themes/modus-vivendi-theme.el
index 0983e26c78..aefef540a1 100644
--- a/etc/themes/modus-vivendi-theme.el
+++ b/etc/themes/modus-vivendi-theme.el
@@ -1,4 +1,4 @@
-;;; modus-vivendi-theme.el --- Elegant, highly legible and customizable light
theme -*- lexical-binding:t -*-
+;;; modus-vivendi-theme.el --- Elegant, highly legible and customizable dark
theme -*- lexical-binding:t -*-
;; Copyright (C) 2019-2022 Free Software Foundation, Inc.
@@ -6,7 +6,7 @@
;; Maintainer: Modus-Themes Development <~protesilaos/modus-themes@lists.sr.ht>
;; URL: https://git.sr.ht/~protesilaos/modus-themes
;; Mailing-List: https://lists.sr.ht/~protesilaos/modus-themes
-;; Version: 2.7.1
+;; Version: 3.0.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: faces, theme, accessibility
@@ -71,4 +71,7 @@ which corresponds to a minimum contrast in relative luminance
of
(provide-theme 'modus-vivendi))
+;;;###theme-autoload
+(put 'modus-vivendi 'theme-properties '(:background-mode dark :kind
color-scheme :family modus))
+
;;; modus-vivendi-theme.el ends here
diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el
index ef00d2ac49..85995e4e99 100644
--- a/etc/themes/tango-dark-theme.el
+++ b/etc/themes/tango-dark-theme.el
@@ -27,10 +27,15 @@
;;; Code:
+;;;###theme-autoload
(deftheme tango-dark
"Face colors using the Tango palette (dark background).
Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
-Semantic, and Ansi-Color faces are included.")
+Semantic, and Ansi-Color faces are included."
+ :background-mode 'dark
+ :kind 'color-scheme
+ :family 'tango)
+
(let ((class '((class color) (min-colors 89)))
;; Tango palette colors.
diff --git a/etc/themes/tango-theme.el b/etc/themes/tango-theme.el
index ecbbf03753..2ac1b42294 100644
--- a/etc/themes/tango-theme.el
+++ b/etc/themes/tango-theme.el
@@ -27,10 +27,14 @@
;;; Code:
+;;;###theme-autoload
(deftheme tango
"Face colors using the Tango palette (light background).
Basic, Font Lock, Isearch, Gnus, Message, Ediff, Flyspell,
-Semantic, and Ansi-Color faces are included.")
+Semantic, and Ansi-Color faces are included."
+ :background-mode 'light
+ :kind 'color-scheme
+ :family 'tango)
(let ((class '((class color) (min-colors 89)))
;; Tango palette colors.
diff --git a/etc/themes/tsdh-dark-theme.el b/etc/themes/tsdh-dark-theme.el
index a88ad75520..6b1e865e42 100644
--- a/etc/themes/tsdh-dark-theme.el
+++ b/etc/themes/tsdh-dark-theme.el
@@ -19,8 +19,12 @@
;;; Code:
+;;;###theme-autoload
(deftheme tsdh-dark
- "A dark theme used and created by Tassilo Horn.")
+ "A dark theme used and created by Tassilo Horn."
+ :background-mode 'dark
+ :kind 'color-scheme
+ :family 'tsdh)
(custom-theme-set-faces
'tsdh-dark
diff --git a/etc/themes/tsdh-light-theme.el b/etc/themes/tsdh-light-theme.el
index d9d09b702b..ac964d66d6 100644
--- a/etc/themes/tsdh-light-theme.el
+++ b/etc/themes/tsdh-light-theme.el
@@ -19,9 +19,13 @@
;;; Code:
+;;;###theme-autoload
(deftheme tsdh-light
"A light Emacs theme.
-Used and created by Tassilo Horn.")
+Used and created by Tassilo Horn."
+ :background-mode 'light
+ :kind 'color-scheme
+ :family 'tsdh)
(custom-theme-set-faces
'tsdh-light
diff --git a/etc/themes/wheatgrass-theme.el b/etc/themes/wheatgrass-theme.el
index c56c8a2d8a..20e7bbbac2 100644
--- a/etc/themes/wheatgrass-theme.el
+++ b/etc/themes/wheatgrass-theme.el
@@ -19,11 +19,14 @@
;;; Code:
+;;;###theme-autoload
(deftheme wheatgrass
"High-contrast green/blue/brown faces on a black background.
Basic, Font Lock, Isearch, Gnus, and Message faces are included.
The default face foreground is wheat, with other faces in shades
-of green, brown, and blue.")
+of green, brown, and blue."
+ :background-mode 'dark
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
diff --git a/etc/themes/whiteboard-theme.el b/etc/themes/whiteboard-theme.el
index f21b18b421..2f86234b32 100644
--- a/etc/themes/whiteboard-theme.el
+++ b/etc/themes/whiteboard-theme.el
@@ -21,8 +21,11 @@
;;; Code:
+;;;###theme-autoload
(deftheme whiteboard
- "Face colors similar to markers on a whiteboard.")
+ "Face colors similar to markers on a whiteboard."
+ :background-mode 'light
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
diff --git a/etc/themes/wombat-theme.el b/etc/themes/wombat-theme.el
index d9fab8ac78..9bb026ead1 100644
--- a/etc/themes/wombat-theme.el
+++ b/etc/themes/wombat-theme.el
@@ -21,11 +21,14 @@
;;; Code:
+;;;###theme-autoload
(deftheme wombat
"Medium-contrast faces with a dark gray background.
Adapted, with permission, from a Vim color scheme by Lars H. Nielsen.
Basic, Font Lock, Isearch, Gnus, Message, and Ansi-Color faces
-are included.")
+are included."
+ :background-mode 'dark
+ :kind 'color-scheme)
(let ((class '((class color) (min-colors 89))))
(custom-theme-set-faces
diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c
index 641570da02..d3af926b63 100644
--- a/lib-src/ebrowse.c
+++ b/lib-src/ebrowse.c
@@ -1574,6 +1574,67 @@ yylex (void)
end_string:
return end_char == '\'' ? CCHAR : CSTRING;
+ case 'R':
+ if (GET (c) == '"')
+ {
+ /* C++11 rstrings. */
+
+#define RSTRING_EOF_CHECK \
+ do { \
+ if (c == '\0') \
+ { \
+ yyerror ("unterminated c++11 rstring", NULL); \
+ UNGET (); \
+ return CSTRING; \
+ } \
+ } while (0)
+
+ char *rstring_prefix_start = in;
+
+ while (GET (c) != '(')
+ {
+ RSTRING_EOF_CHECK;
+ if (c == '"')
+ {
+ yyerror ("malformed c++11 rstring", NULL);
+ return CSTRING;
+ }
+ }
+ char *rstring_prefix_end = in - 1;
+ while (TRUE)
+ {
+ switch (GET (c))
+ {
+ default:
+ RSTRING_EOF_CHECK;
+ break;
+ case '\n':
+ INCREMENT_LINENO;
+ break;
+ case ')':
+ {
+ char *in_saved = in;
+ char *prefix = rstring_prefix_start;
+ while (prefix != rstring_prefix_end && GET (c) == *prefix)
+ {
+ RSTRING_EOF_CHECK;
+ prefix++;
+ }
+ if (prefix == rstring_prefix_end)
+ {
+ if (GET (c) == '"')
+ return CSTRING;
+ RSTRING_EOF_CHECK;
+ }
+ in = in_saved;
+ }
+ }
+ }
+ }
+
+ UNGET ();
+ /* Fall through to identifiers and keywords. */
+ FALLTHROUGH;
case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': case 'g':
case 'h': case 'i': case 'j': case 'k': case 'l': case 'm': case 'n':
@@ -1581,7 +1642,7 @@ yylex (void)
case 'v': case 'w': case 'x': case 'y': case 'z':
case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': case 'G':
case 'H': case 'I': case 'J': case 'K': case 'L': case 'M': case 'N':
- case 'O': case 'P': case 'Q': case 'R': case 'S': case 'T': case 'U':
+ case 'O': case 'P': case 'Q': case 'S': case 'T': case 'U':
case 'V': case 'W': case 'X': case 'Y': case 'Z': case '_':
{
/* Identifier and keywords. */
diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c
index 425db8cfac..ee124ea135 100644
--- a/lib-src/emacsclient.c
+++ b/lib-src/emacsclient.c
@@ -2240,7 +2240,7 @@ main (int argc, char **argv)
char *str = unquote_argument (p + strlen ("-error "));
if (!skiplf)
printf ("\n");
- fprintf (stderr, "*ERROR*: %s", str);
+ message (true, "*ERROR*: %s", str);
if (str[0])
skiplf = str[strlen (str) - 1] == '\n';
exit_status = EXIT_FAILURE;
diff --git a/lib-src/rcs2log b/lib-src/rcs2log
index bc7875cfdd..2a72404d9e 100755
--- a/lib-src/rcs2log
+++ b/lib-src/rcs2log
@@ -209,7 +209,7 @@ month_data='
if type mktemp >/dev/null 2>&1; then
logdir=`mktemp -d`
else
- logdir=$TMPDIR/rcs2log$$
+ logdir="${TMPDIR-/tmp}/rcs2log$$"
(umask 077 && mkdir "$logdir")
fi || exit
case $logdir in
diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c
index 041bf5c749..7e54b878a2 100644
--- a/lib-src/seccomp-filter.c
+++ b/lib-src/seccomp-filter.c
@@ -206,6 +206,9 @@ main (int argc, char **argv)
SCMP_A2_32 (SCMP_CMP_MASKED_EQ,
~(PROT_NONE | PROT_READ | PROT_WRITE), 0));
+ /* Allow restartable sequences. The dynamic linker uses them. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (rseq));
+
/* Futexes are used everywhere. */
RULE (SCMP_ACT_ALLOW, SCMP_SYS (futex),
SCMP_A1_32 (SCMP_CMP_EQ, FUTEX_WAKE_PRIVATE));
@@ -218,6 +221,7 @@ main (int argc, char **argv)
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getuid));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (geteuid));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpid));
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (gettid));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (getpgrp));
/* Allow operations on open file descriptors. File descriptors are
@@ -324,6 +328,8 @@ main (int argc, char **argv)
| CLONE_SETTLS | CLONE_PARENT_SETTID
| CLONE_CHILD_CLEARTID),
0));
+ /* glibc 2.34+ pthread_create uses clone3. */
+ RULE (SCMP_ACT_ALLOW, SCMP_SYS (clone3));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (sigaltstack));
RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_robust_list));
diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10
index 0b97a64109..de73fe7f0a 100644
--- a/lisp/ChangeLog.10
+++ b/lisp/ChangeLog.10
@@ -1737,7 +1737,7 @@
(bibtex-find-crossref, bibtex-find-entry): New funs.
(bibtex-find-entry-location): Rename to bibtex-prepare-new-entry, use
bibtex-lessp, Simplify.
- (bibtex-validate): Simplify. Fixe bug of internal variable
+ (bibtex-validate): Simplify. Fix bug of internal variable
questionable-month.
(bibtex-remove-OPT-or-ALT): Use when.
(bibtex-remove-delimiters, bibtex-kill-field, bibtex-kill-entry)
@@ -9449,7 +9449,7 @@
Use shy group.
(outline-level) <var>: Update calling convention.
(outline-level) <fun>: Take advantage of it.
- (outline-demote): Don't assume the match-data is still uptodate.
+ (outline-demote): Don't assume the match-data is still up-to-date.
(outline-up-heading): Simplify and make sure the match data is
properly set at the end.
@@ -9490,7 +9490,7 @@
toolbar/rescan.pbm, toolbar/rescan.xpm, toolbar/show.pbm,
toolbar/show.xpm, toolbar/widen.pbm, toolbar/widen.xpm:
Upgraded to mh-e version 6.1.1. Full ChangeLog available in
- http://prdownloads.sourceforge.net/mh-e/mh-e-6.1.tgz?download .
+ https://prdownloads.sourceforge.net/mh-e/mh-e-6.1.tgz?download .
There were no user-visible changes in 6.1.1 from 6.1--only the
section of the Makefile that installs the files into Emacs was changed.
diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12
index a89e515510..0796965a9b 100644
--- a/lisp/ChangeLog.12
+++ b/lisp/ChangeLog.12
@@ -1556,7 +1556,7 @@
(org-search-not-self): Rename from `org-search-not-link'.
(org-open-link-marker): New variable.
(org-open-at-point): Set `org-open-link-marker'.
- (org-print-icalendar-entries): Fixe bug with excluding DONE
+ (org-print-icalendar-entries): Fix bug with excluding DONE
entries from the exported list.
(org-edit-formula-lisp-indent): New command.
(orgtbl-to-texinfo, orgtbl-to-html): New functions.
@@ -5243,7 +5243,7 @@
2006-10-11 Ilya Zakharevich <ilyaz@cpan.org>
- * progmodes/cperl-mode.el: Merge from upstream, upto version 5.22.
+ * progmodes/cperl-mode.el: Merge from upstream, up to version 5.22.
After 5.0:
(cperl-add-tags-recurse-noxs-fullpath): New function (for -batch mode).
@@ -5551,7 +5551,7 @@
(cperl-next-interpolated-REx-1): Likewise.
"\C-c\C-x", "\C-c\C-y", "\C-c\C-v": New keybinding for these functions.
Perl/Regexp menu: 3 new entries for `cperl-next-interpolated-REx'.
- (cperl-praise): Mention finded interpolated RExen.
+ (cperl-praise): Mention finding interpolated RExen.
After 5.19:
(cperl-init-faces): Highlight %$foo, @$foo too.
@@ -11874,7 +11874,7 @@
* files.el (hack-local-variables-confirm): Don't prompt for ! if
enable-local-variables is set to always query, or there is no
- savable variable.
+ saveable variable.
2006-03-10 Bill Wohler <wohler@newt.com>
diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13
index 369aec81ef..326003d9d9 100644
--- a/lisp/ChangeLog.13
+++ b/lisp/ChangeLog.13
@@ -1070,7 +1070,7 @@
* international/mule-cmds.el (char-code-property-alist): New variable.
(define-char-code-property): New function.
(get-char-code-property, put-char-code-property): Handle a
- char-table registerd in char-code-property-alist.
+ char-table registered in char-code-property-alist.
(set-language-environment): Check :ascii-compatible-p property of
nonascii charset instead of its dimension.
@@ -13901,7 +13901,7 @@
2007-07-23 Stefan Monnier <monnier@iro.umontreal.ca>
* ses.el (ses-cleanup): Prevent Emacs from spuriously checking if the
- underlying file is uptodate.
+ underlying file is up-to-date.
2007-07-23 Christopher J. Madsen <cjm@cjmweb.net>
@@ -15245,7 +15245,7 @@
2007-06-25 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/autoload.el (autoload-modified-buffers): New var.
- (autoload-find-destination): Keep it uptodate.
+ (autoload-find-destination): Keep it up-to-date.
(autoload-save-buffers): New fun.
(update-file-autoloads): Use it. Re-add the "up to date" message.
diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14
index c84e44536d..8d8c611778 100644
--- a/lisp/ChangeLog.14
+++ b/lisp/ChangeLog.14
@@ -155,7 +155,7 @@
* epa.el (epa-decrypt-region): Detect encoding if
coding-system-for-read is not specified.
- <http://sourceforge.jp/ticket/browse.php?group_id=2267&tid=17018>
+ <https://sourceforge.jp/ticket/browse.php?group_id=2267&tid=17018>
(epa-verify-region): Ditto.
2009-06-04 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -540,7 +540,7 @@
* epa-file.el (epa-file-decode-and-insert):
Use string-to-multibyte instead of set-buffer-multibyte.
- <http://sourceforge.jp/ticket/browse.php?group_id=2267&tid=15259>
+ <https://sourceforge.jp/ticket/browse.php?group_id=2267&tid=15259>
2009-04-18 Yann Hodique <yann.hodique@gmail.com> (tiny change)
@@ -6103,7 +6103,7 @@
* international/quail.el (quail-show-guidance): Don't create
a guidance-frame if current buffer is not a minibuffer, since even if
selected-window is mini-p, the buffer will never be displayed in it, so
- it wil be usable for guidance.
+ it will be usable for guidance.
2008-10-28 Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15
index 53caf69e1c..8a21c291e7 100644
--- a/lisp/ChangeLog.15
+++ b/lisp/ChangeLog.15
@@ -11955,7 +11955,7 @@
(verilog-skip-backward-comments, verilog-skip-forward-comment-p):
fix bug for /* / comments.
(verilog-backward-syntactic-ws, verilog-forward-syntactic-ws):
- Speed up and simplfy as this is never called with a bound.
+ Speed up and simplify as this is never called with a bound.
(verilog-pretty-declarations): Enhance to line up declarations
inside a parameter list, suggested by Alan Morgan.
(verilog-pretty-expr): Tune assignment regular expression match
@@ -15783,7 +15783,7 @@
* simple.el (with-wrapper-hook): Fix thinko.
* hfy-cmap.el (hfy-rgb-file): Use locate-file.
- (htmlfontify-load-rgb-file): Remove unnused var `ff'.
+ (htmlfontify-load-rgb-file): Remove unused var `ff'.
Use with-current-buffer and string-to-number.
(hfy-fallback-colour-values): Use assoc-string.
* htmlfontify.el (hfy-face-to-css): Remove unused var `style'.
@@ -22575,7 +22575,7 @@
2009-06-28 Juri Linkov <juri@jurta.org>
- * help-fns.el (describe-function-1): Correctly locate adviced
+ * help-fns.el (describe-function-1): Correctly locate advised
functions in hyperlink (Bug#2438).
2009-06-28 Chong Yidong <cyd@stupidchicken.com>
@@ -22762,7 +22762,7 @@
Automatically handle .xz suffix (XZ-compressed files), too.
* jka-cmpr-hook.el (jka-compr-compression-info-list): Add xz.
- XZ is the successor to LZMA: <http://tukaani.org/xz/>
+ XZ is the successor to LZMA: <https://tukaani.org/xz/>
2009-06-22 Dmitry Dzhus <dima@sphinx.net.ru>
Nick Roberts <nickrob@snap.net.nz>
diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16
index f0a50bb4bc..7b57c014d2 100644
--- a/lisp/ChangeLog.16
+++ b/lisp/ChangeLog.16
@@ -2814,7 +2814,7 @@
2012-12-12 Jonas Bernoulli <jonas@bernoul.li>
* emacs-lisp/eieio.el: Prettier object pretty-printing (bug#13115).
- (eieio-override-prin1): Don't quote kewords and booleans.
+ (eieio-override-prin1): Don't quote keywords and booleans.
(object-write) <eieio-default-superclass>: Don't put closing parens
on new line, avoid needless empty lines, align values that are objects
with the slot keyword (instead of beginning on the same line).
@@ -10765,7 +10765,7 @@
* play/zone.el (zone-hiding-mode-line): Rename from
zone-hiding-modeline. All callers changed.
- (zone): Remove unusued `modeline-hidden-level' property.
+ (zone): Remove unused `modeline-hidden-level' property.
* progmodes/xscheme.el (xscheme-mode-line-initialize): Rename from
xscheme-modeline-initialize. All callers changed.
@@ -10931,7 +10931,7 @@
2012-05-29 Aaron S. Hawley <aaron.s.hawley@gmail.com>
- * vc/vc.el (vc-revert, vc-rollback): Dont kill vc-diff buffer on
+ * vc/vc.el (vc-revert, vc-rollback): Don't kill vc-diff buffer on
revert (Bug#11488).
2012-05-29 Juri Linkov <juri@jurta.org>
@@ -15340,7 +15340,7 @@
* subr.el (with-selected-frame): Mention that the selected frame
is restored (bug#9980).
- * ibuffer.el (ibuffer-mode): List the bindings in the corrent map
+ * ibuffer.el (ibuffer-mode): List the bindings in the correct map
(bug#9759).
* mail/smtpmail.el (password-cache-add): Remove unused declaration.
@@ -22838,15 +22838,14 @@
2011-05-10 Jim Meyering <meyering@redhat.com>
Fix doubled-word typos.
- * international/quail.el (quail-insert-kbd-layout): and and -> and.
- * kermit.el: and and -> and.
- * net/ldap.el (ldap-search-internal): to to -> to.
- * progmodes/vhdl-mode.el (vhdl-offsets-alist): Likewise.
- * progmodes/js.el (js-mode): and and -> and.
- * textmodes/artist.el (artist-move-to-xy): at at -> at.
- (artist-draw-region-trim-line-endings): if if -> if.
- And Safetyc -> Safety.
- * textmodes/reftex-dcr.el (reftex-view-crossref): at at -> at a.
+ * international/quail.el (quail-insert-kbd-layout):
+ * kermit.el:
+ * net/ldap.el (ldap-search-internal):
+ * progmodes/vhdl-mode.el (vhdl-offsets-alist):
+ * progmodes/js.el (js-mode):
+ * textmodes/artist.el (artist-move-to-xy):
+ (artist-draw-region-trim-line-endings):
+ * textmodes/reftex-dcr.el (reftex-view-crossref): Fix typos.
2011-05-10 Glenn Morris <rgm@gnu.org>
Stefan Monnier <monnier@iro.umontreal.ca>
@@ -24104,7 +24103,7 @@
* emacs-lisp/lisp-mode.el (eval-defun-2): Use eval-sexp-add-defvars.
- * htmlfontify.el (hfy-etags-cmd): Remove inoperant eval-and-compile.
+ * htmlfontify.el (hfy-etags-cmd): Remove inoperative eval-and-compile.
(hfy-e2x-etags-cmd, hfy-etags-cmd-alist-default)
(hfy-etags-cmd-alist): Don't eval-and-compile any more.
diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17
index cebafe18aa..c494f43896 100644
--- a/lisp/ChangeLog.17
+++ b/lisp/ChangeLog.17
@@ -917,7 +917,7 @@
* desktop.el (desktop-buffer-info): Write docstring.
(desktop-buffer-info): Use `pushnew' instead of `add-to-list' and
- unquote lamda.
+ unquote lambda.
* emacs-lisp/package.el (package-refresh-contents): Update doc.
@@ -14039,7 +14039,7 @@
* epa-file.el (epa-file-write-region): Encode the region according
to `buffer-file-format'. Problem reported at:
- <http://sourceforge.jp/ticket/browse.php?group_id=2267&tid=32917>.
+ <https://sourceforge.jp/ticket/browse.php?group_id=2267&tid=32917>.
2014-01-14 Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/lisp/ChangeLog.3 b/lisp/ChangeLog.3
index 7f5ceb4b85..e23226b844 100644
--- a/lisp/ChangeLog.3
+++ b/lisp/ChangeLog.3
@@ -7326,8 +7326,7 @@
1991-07-13 Jim Blandy (jimb@churchy.gnu.ai.mit.edu)
* info.el (Info-find-node): Call buffer-flush-undo with one arg,
- instead of none. Change call to get-buffer-c>reate to
- get-buffer-create.
+ instead of none. Fix typo in call to get-buffer-create.
* startup.el (command-line): Remove the arguments from
command-line-args as we process them.
diff --git a/lisp/ChangeLog.4 b/lisp/ChangeLog.4
index e965dbb5ef..ea0502975e 100644
--- a/lisp/ChangeLog.4
+++ b/lisp/ChangeLog.4
@@ -6858,7 +6858,7 @@
1993-07-26 Richard Stallman (rms@mole.gnu.ai.mit.edu)
* frame.el (frame-notice-user-settings): Don't reapply a parm
- whose value is ot changed (as far as we know) since frame-initialize.
+ whose value is not changed (as far as we know) since frame-initialize.
* simple.el (kill-ring-save): Delete spurious `message' call.
(set-mark): If POS is nil, call deactivate-mark.
diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6
index e2128b94c0..27d522aaf2 100644
--- a/lisp/ChangeLog.6
+++ b/lisp/ChangeLog.6
@@ -7392,7 +7392,7 @@
(ada-format-paramlist): Simplified a regexp.
(ada-indent-current): On first line of the buffer, indent to column 0.
Don't reindent if new position is the same as the old one. Thus, a
- correctly indended line is not modified.
+ correctly indented line is not modified.
(ada-get-indent-subprog): Simplified a regexp.
(ada-goto-matching-decl-start): Distinguish between normal type
declaration and protected types, which are more like procedures.
diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7
index 747a9ffab9..3220832454 100644
--- a/lisp/ChangeLog.7
+++ b/lisp/ChangeLog.7
@@ -3147,20 +3147,20 @@
* international/ccl.el: Change term translate-XXX-map to map-XXX
throughout the file. Change terms unify/unification to
- translate/translation respectively throughtout the file.
+ translate/translation respectively throughout the file.
* international/quail.el (quail-completion): Consecutive call of
this command scrolls the Quail completion buffer.
* international/mule.el: Change term unification to translation
- throughtout the file.
+ throughout the file.
(set-clipboard-coding-system): New function.
* international/mule-conf.el: Change term unification to
- translation throughtout the file.
+ translation throughout the file.
* international/mule-util.el: Change term unification to
- translation throughtout the file.
+ translation throughout the file.
1998-05-17 Richard Stallman <rms@psilocin.ai.mit.edu>
@@ -20821,7 +20821,7 @@
function word-help-find-help-file.
(word-help-guess-all): New subroutine.
(word-help-guess): Use word-help-guess-all.
- May optionally copy only upto the cursor,
+ May optionally copy only up to the cursor,
instead of the entire keyword.
1997-01-01 Richard Stallman <rms@ethanol.gnu.ai.mit.edu>
diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8
index 78fc7e2056..a14d682192 100644
--- a/lisp/ChangeLog.8
+++ b/lisp/ChangeLog.8
@@ -4356,7 +4356,7 @@
1999-07-21 Gerd Moellmann <gerd@gnu.org>
* scroll-bar.el (scroll-bar-toolkit-scroll): New.
- (global): Use different key bindings if using tookit scroll bars.
+ (global): Use different key bindings if using toolkit scroll bars.
1999-07-21 Gerd Moellmann <gerd@gnu.org>
@@ -9712,7 +9712,7 @@
(ps-mule-font-info-database-ps-bdf): New variable.
(ccl-encode-ethio-unicode): Bug of CCL code fixed.
(ps-mule-generate-font): Give CHARSET arg to FONT-FUNC function
- registerd in FONT-SPEC.
+ registered in FONT-SPEC.
(ps-mule-bitmap-prologue): Fix PostScript code to realize correct
character width of bitmap fonts.
(ps-mule-generate-bitmap-font): Give COLUMNS arg to PostScript
diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9
index a8ebe81e7d..4cb10d2d55 100644
--- a/lisp/ChangeLog.9
+++ b/lisp/ChangeLog.9
@@ -789,7 +789,7 @@
(command-line-1): If inhibit-startup-buffer-menu is set, don't
display the buffer menu. From Simon Josefsson <jas@extundo.com>.
- This allows upto 99999 messages in the summary without screwing up
+ This allows up to 99999 messages in the summary without screwing up
the summary sorting. Previously 9999 was the maximum. Added to NEWS.
* mail/rmailsum.el (rmail-make-summary-line)
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 256017f6c5..338814fdda 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -430,6 +430,12 @@ compile-always:
find $(lisp) -name '*.elc' $(FIND_DELETE)
$(MAKE) compile
+.PHONY: trampolines
+trampolines: compile
+ifeq ($(HAVE_NATIVE_COMP),yes)
+ $(emacs) -l comp -f comp-compile-all-trampolines
+endif
+
.PHONY: backup-compiled-files compile-after-backup
# Backup compiled Lisp files in elc.tar.gz. If that file already
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
index a4f0196a78..2ca8e25dac 100644
--- a/lisp/abbrev.el
+++ b/lisp/abbrev.el
@@ -1221,7 +1221,7 @@ SORTFUN is passed to `sort' to change the default
ordering."
(defface abbrev-table-name
'((t :inherit font-lock-function-name-face))
- "Face used for displaying the abbrev table name in `edit-abbrev-mode'."
+ "Face used for displaying the abbrev table name in `edit-abbrevs-mode'."
:version "29.1")
(defvar edit-abbrevs-mode-font-lock-keywords
diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el
index 7a65777d32..4eab2c11c6 100644
--- a/lisp/allout-widgets.el
+++ b/lisp/allout-widgets.el
@@ -2177,7 +2177,7 @@ Operation is inhibited by
`allout-inhibit-body-modification-handler'."
;; ?? Escapes removal (before changes) is not done when edits span multiple
;; items, recognizing that item structure is being preserved, including
;; escaping of item-prefix-like text within bodies. See
-;; `allout-before-modification-handler' and
+;; `allout-body-modification-handler' and
;; `allout-inhibit-body-modification-handler'.
;;
;; Adds the overlay to the `allout-unresolved-body-mod-workroster' during
diff --git a/lisp/allout.el b/lisp/allout.el
index 5f7087829e..df0181cecb 100644
--- a/lisp/allout.el
+++ b/lisp/allout.el
@@ -5356,9 +5356,6 @@ alternate presentation form:
`flat' -- Present prefix as numeric section.subsection..., starting with
section indicated by the START-NUM, innermost nesting first.
- X`flat-indented' -- Prefix is like `flat' for first topic at each
- X level, but subsequent topics have only leaf topic
- X number, padded with blanks to line up with first.
`indent' (symbol) -- Convert header prefixes to all white space,
except for distinctive bullets.
diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el
index 6f1c270c23..5e7015db54 100644
--- a/lisp/ansi-color.el
+++ b/lisp/ansi-color.el
@@ -418,7 +418,7 @@ and it should apply face FACE to the text between BEG and
END.")
(setq ansi-color-for-comint-mode 'filter))
;;;###autoload
-(defun ansi-color-process-output (ignored)
+(defun ansi-color-process-output (_ignored)
"Maybe translate SGR control sequences of comint output into text properties.
Depending on variable `ansi-color-for-comint-mode' the comint output is
diff --git a/lisp/ansi-osc.el b/lisp/ansi-osc.el
index 34154998cd..a8523fc9dc 100644
--- a/lisp/ansi-osc.el
+++ b/lisp/ansi-osc.el
@@ -125,13 +125,11 @@ and `shell-dirtrack-mode'."
;; Hyperlink handling (OSC 8)
-(defvar ansi-osc-hyperlink-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\r" 'browse-url-button-open)
- (define-key map [mouse-2] 'browse-url-button-open)
- (define-key map [follow-link] 'mouse-face)
- map)
- "Keymap used by OSC 8 hyperlink buttons.")
+(defvar-keymap ansi-osc-hyperlink-map
+ :doc "Keymap used by OSC 8 hyperlink buttons."
+ "C-c RET" #'browse-url-button-open
+ "<mouse-2>" #'browse-url-button-open
+ "<follow-link>" 'mouse-face)
(define-button-type 'ansi-osc-hyperlink
'keymap ansi-osc-hyperlink-map
@@ -143,7 +141,7 @@ and `shell-dirtrack-mode'."
(defun ansi-osc-hyperlink-handler (_ text)
"Create a hyperlink from an OSC 8 escape sequence.
-This function is intended to be included as an elemnt of the list
+This function is intended to be included as an element of the list
that is the value of `ansi-osc-handlers'."
(when ansi-osc-hyperlink--state
(let ((start (car ansi-osc-hyperlink--state))
diff --git a/lisp/apropos.el b/lisp/apropos.el
index 624c29cb41..a731926f45 100644
--- a/lisp/apropos.el
+++ b/lisp/apropos.el
@@ -25,8 +25,7 @@
;;; Commentary:
;; The ideas for this package were derived from the C code in
-;; src/keymap.c and elsewhere. The functions in this file should
-;; always be byte-compiled for speed.
+;; src/keymap.c and elsewhere.
;; The idea for super-apropos is based on the original implementation
;; by Lynn Slater <lrs@esl.com>.
@@ -493,7 +492,7 @@ Intended as a value for `revert-buffer-function'."
\\{apropos-mode-map}"
(make-local-variable 'apropos--current)
(setq-local revert-buffer-function #'apropos--revert-buffer)
- (setq-local outline-regexp "^[^ \n]+"
+ (setq-local outline-search-function #'outline-search-level
outline-level (lambda () 1)
outline-minor-mode-cycle t
outline-minor-mode-highlight t
@@ -652,7 +651,8 @@ while a list of strings is used as a word list."
(defun apropos (pattern &optional do-all)
"Show all meaningful Lisp symbols whose names match PATTERN.
Symbols are shown if they are defined as functions, variables, or
-faces, or if they have nonempty property lists.
+faces, or if they have nonempty property lists, or if they are
+known keywords.
PATTERN can be a word, a list of words (separated by spaces),
or a regexp (using some regexp special characters). If it is a word,
@@ -1188,7 +1188,8 @@ as a heading."
(insert-text-button (symbol-name symbol)
'type 'apropos-symbol
'skip apropos-multi-type
- 'face 'apropos-symbol)
+ 'face 'apropos-symbol
+ 'outline-level 1)
(setq button-end (point))
(if (and (eq apropos-sort-by-scores 'verbose)
(cadr apropos-item))
diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 0955e2ed07..dc274843e1 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -55,13 +55,27 @@
:type 'string
:version "27.1")
+(defcustom auth-source-pass-extra-query-keywords t
+ "Whether to consider additional keywords when performing a query.
+Specifically, when the value is t, recognize the `:max' and
+`:require' keywords and accept lists of query parameters for
+certain keywords, such as `:host' and `:user'. Also, wrap all
+returned secrets in a function and forgo any further results
+filtering unless given an applicable `:require' argument. When
+this option is nil, do none of that, and enact the narrowing
+behavior described toward the bottom of the Info node `(auth) The
+Unix password store'."
+ :type 'boolean
+ :version "29.1")
+
(cl-defun auth-source-pass-search (&rest spec
&key backend type host user port
+ require max
&allow-other-keys)
"Given some search query, return matching credentials.
See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE,
-HOST, USER and PORT."
+HOST, USER, PORT, REQUIRE, and MAX."
(cl-assert (or (null type) (eq type (oref backend type)))
t "Invalid password-store search: %s %s")
(cond ((eq host t)
@@ -70,6 +84,8 @@ HOST, USER and PORT."
((null host)
;; Do not build a result, as none will match when HOST is nil
nil)
+ (auth-source-pass-extra-query-keywords
+ (auth-source-pass--build-result-many host port user require max))
(t
(when-let ((result (auth-source-pass--build-result host port user)))
(list result)))))
@@ -89,6 +105,39 @@ HOSTS can be a string or a list of strings."
(seq-subseq retval 0 -2)) ;; remove
password
retval))))
+(defvar auth-source-pass--match-regexp nil)
+
+(defun auth-source-pass--match-regexp (s)
+ (rx-to-string ; autoloaded
+ `(: (or bot "/")
+ (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@")
+ (group-n 10 (+ (not (in ?\ ?/ ?@ ,s))))
+ (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s))))))
+ (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s))))
+ (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s)))))
+ (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s)))))))
+ eot)
+ 'no-group))
+
+(defun auth-source-pass--build-result-many (hosts ports users require max)
+ "Return multiple `auth-source-pass--build-result' values."
+ (unless (listp hosts) (setq hosts (list hosts)))
+ (unless (listp users) (setq users (list users)))
+ (unless (listp ports) (setq ports (list ports)))
+ (let* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp
+ auth-source-pass-port-separator))
+ (rv (auth-source-pass--find-match-many hosts users ports
+ require (or max 1))))
+ (when auth-source-debug
+ (auth-source-pass--do-debug "final result: %S" rv))
+ (let (out)
+ (dolist (e rv out)
+ (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1
+ (v (auth-source--obfuscate s)))
+ (setf (plist-get e :secret)
+ (lambda () (auth-source--deobfuscate v))))
+ (push e out)))))
+
;;;###autoload
(defun auth-source-pass-enable ()
"Enable auth-source-password-store."
@@ -206,6 +255,67 @@ HOSTS can be a string or a list of strings."
hosts
(list hosts))))
+(defun auth-source-pass--retrieve-parsed (seen path port-number-p)
+ (when (string-match auth-source-pass--match-regexp path)
+ (puthash path
+ `( :host ,(or (match-string 10 path) (match-string 11 path))
+ ,@(if-let* ((tr (match-string 21 path)))
+ (list :user tr :suffix t)
+ (list :user (match-string 20 path)))
+ :port ,(and-let* ((p (or (match-string 30 path)
+ (match-string 31 path)))
+ (n (string-to-number p)))
+ (if (or (zerop n) (not port-number-p))
+ (format "%s" p)
+ n)))
+ seen)))
+
+(defun auth-source-pass--match-parts (parts key value require)
+ (let ((mv (plist-get parts key)))
+ (if (memq key require)
+ (and value (equal mv value))
+ (or (not value) (not mv) (equal mv value)))))
+
+(defun auth-source-pass--find-match-many (hosts users ports require max)
+ "Return plists for valid combinations of HOSTS, USERS, PORTS."
+ (let ((seen (make-hash-table :test #'equal))
+ (entries (auth-source-pass-entries))
+ out suffixed suffixedp)
+ (catch 'done
+ (dolist (host hosts out)
+ (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host)))
+ (unless (or (not (equal "443" p)) (string-prefix-p "https://"; host))
+ (setq p nil))
+ (dolist (user (or users (list u)))
+ (dolist (port (or ports (list p)))
+ (dolist (e entries)
+ (when-let*
+ ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed
+ seen e (integerp port))))
+ ((equal host (plist-get m :host)))
+ ((auth-source-pass--match-parts m :port port require))
+ ((auth-source-pass--match-parts m :user user require))
+ (parsed (auth-source-pass-parse-entry e))
+ ;; For now, ignore body-content pairs, if any,
+ ;; from `auth-source-pass--parse-data'.
+ (secret (or (auth-source-pass--get-attr 'secret parsed)
+ (not (memq :secret require)))))
+ (push
+ `( :host ,host ; prefer user-provided :host over h
+ ,@(and-let* ((u (plist-get m :user))) (list :user u))
+ ,@(and-let* ((p (plist-get m :port))) (list :port p))
+ ,@(and secret (not (eq secret t)) (list :secret secret)))
+ (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+ (unless suffixedp
+ (when (or (zerop (cl-decf max))
+ (null (setq entries (delete e entries))))
+ (throw 'done out)))))
+ (setq suffixed (nreverse suffixed))
+ (while suffixed
+ (push (pop suffixed) out)
+ (when (zerop (cl-decf max))
+ (throw 'done out))))))))))
+
(defun auth-source-pass--disambiguate (host &optional user port)
"Return (HOST USER PORT) after disambiguation.
Disambiguate between having user provided inside HOST (e.g.,
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
index 580f6b3ced..354b28da5a 100644
--- a/lisp/autoinsert.el
+++ b/lisp/autoinsert.el
@@ -135,7 +135,7 @@ If this contains a %s, that will be replaced by the
matching rule."
(if (eq major-mode (default-value 'major-mode))
(sh-mode))))
- (ada-mode . ada-header)
+ (ada-mode . ada-skel-initial-string)
(("\\.[1-9]\\'" . "Man page skeleton")
"Short description: "
@@ -168,7 +168,7 @@ If this contains a %s, that will be replaced by the
matching rule."
(".dir-locals.el"
nil
- ";;; Directory Local Variables\n"
+ ";;; Directory Local Variables -*- no-byte-compile: t; -*-\n"
";;; For more information see (info \"(emacs) Directory Variables\")\n\n"
"(("
'(setq v1 (let (modes)
diff --git a/lisp/autorevert.el b/lisp/autorevert.el
index 576659675b..e3d66c04bc 100644
--- a/lisp/autorevert.el
+++ b/lisp/autorevert.el
@@ -297,9 +297,10 @@ You should set this variable through Custom."
(defcustom auto-revert-notify-exclude-dir-regexp
(concat
;; No mounted file systems.
- "^" (regexp-opt '("/afs/" "/media/" "/mnt" "/net/" "/tmp_mnt/"))
+ mounted-file-systems
;; No remote files.
- (unless auto-revert-remote-files "\\|^/[^/|:][^/|]+:"))
+ (unless auto-revert-remote-files
+ (rx (| "" (: bol "/" (not (any "/:|")) (1+ (not (any "/|"))) ":")))))
"Regular expression of directories to be excluded from file notifications."
:group 'auto-revert
:type 'regexp
diff --git a/lisp/battery.el b/lisp/battery.el
index a874f0640e..8de80109c6 100644
--- a/lisp/battery.el
+++ b/lisp/battery.el
@@ -938,16 +938,14 @@ The following %-sequences are provided:
%t Remaining time (to charge or discharge) in the form `h:min'"
(let* ((os-name (car (split-string
;; FIXME: Can't we use something like `system-type'?
- (battery--call-process-to-string
- (executable-find "uname")))))
+ (battery--call-process-to-string "uname"))))
(apm-flag (pcase os-name
("OpenBSD" "mP")
("FreeBSD" "st")
(_ "ms")))
(apm-args (concat "-abl" apm-flag))
(apm-output (split-string
- (battery--call-process-to-string
- (executable-find "apm") apm-args)))
+ (battery--call-process-to-string "apm" apm-args)))
(indices (pcase os-name
;; FreeBSD's manpage documents that multiple
;; outputs are ordered by "the order in which
diff --git a/lisp/bindings.el b/lisp/bindings.el
index 2e32128274..c1ad5f7520 100644
--- a/lisp/bindings.el
+++ b/lisp/bindings.el
@@ -1029,6 +1029,14 @@ if `inhibit-field-text-motion' is non-nil."
(define-key global-map [XF86Back] 'previous-buffer)
(put 'previous-buffer :advertised-binding [?\C-x left])
+(defvar-keymap buffer-navigation-repeat-map
+ :doc "Keymap to repeat `next-buffer' and `previous-buffer'. Used in
`repeat-mode'."
+ "<right>" #'next-buffer
+ "<left>" #'previous-buffer)
+
+(put 'next-buffer 'repeat-map 'buffer-navigation-repeat-map)
+(put 'previous-buffer 'repeat-map 'buffer-navigation-repeat-map)
+
(let ((map minibuffer-local-map))
(define-key map "\en" 'next-history-element)
(define-key map [next] 'next-history-element)
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
index b57ad12986..7f3a264f53 100644
--- a/lisp/bookmark.el
+++ b/lisp/bookmark.el
@@ -365,8 +365,8 @@ BOOKMARK-RECORD is, e.g., one element from
`bookmark-alist'."
(car bookmark-record))
(defun bookmark-type-from-full-record (bookmark-record)
- "Return then type of BOOKMARK-RECORD.
-BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'. It's
+ "Return the type of BOOKMARK-RECORD.
+BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'. Its
type is read from the symbol property named
`bookmark-handler-type' read on the record handler function."
(let ((handler (bookmark-get-handler bookmark-record)))
@@ -1396,20 +1396,25 @@ after a bookmark was set in it."
(interactive (list (bookmark-completing-read "Bookmark to relocate")))
(bookmark-maybe-historicize-string bookmark-name)
(bookmark-maybe-load-default-file)
- (let* ((bmrk-filename (bookmark-get-filename bookmark-name))
- (newloc (abbreviate-file-name
- (expand-file-name
- (read-file-name
- (format "Relocate %s to: " bookmark-name)
- (file-name-directory bmrk-filename))))))
- (bookmark-set-filename bookmark-name newloc)
- (bookmark-update-last-modified bookmark-name)
- (setq bookmark-alist-modification-count
- (1+ bookmark-alist-modification-count))
- (if (bookmark-time-to-save-p)
+ (let ((bmrk-filename (bookmark-get-filename bookmark-name)))
+ ;; FIXME: Make `bookmark-relocate' support bookmark Types
+ ;; besides files and directories.
+ (unless bmrk-filename
+ (user-error "Cannot relocate bookmark of type \"%s\""
+ (bookmark-type-from-full-record
+ (bookmark-get-bookmark bookmark-name))))
+ (let ((newloc (abbreviate-file-name
+ (expand-file-name
+ (read-file-name
+ (format "Relocate %s to: " bookmark-name)
+ (file-name-directory bmrk-filename))))))
+ (bookmark-set-filename bookmark-name newloc)
+ (bookmark-update-last-modified bookmark-name)
+ (setq bookmark-alist-modification-count
+ (1+ bookmark-alist-modification-count))
+ (when (bookmark-time-to-save-p)
(bookmark-save))
- (bookmark-bmenu-surreptitiously-rebuild-list)))
-
+ (bookmark-bmenu-surreptitiously-rebuild-list))))
;;;###autoload
(defun bookmark-insert-location (bookmark-name &optional no-history)
diff --git a/lisp/bs.el b/lisp/bs.el
index aabc2dc558..1fd31fb3b8 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -25,7 +25,7 @@
;;; Commentary:
-;; The bs-package contains a main function bs-show for popping up a
+;; The bs package contains a main function `bs-show' for popping up a
;; buffer in a way similar to `list-buffers' and `electric-buffer-list':
;; The new buffer offers a Buffer Selection Menu for manipulating
;; the buffer list and buffers.
@@ -42,18 +42,18 @@
;;; Quick Installation and Customization:
-;; To display the bs menu, do
+;; To display the bs menu, type
;; M-x bs-show
-;; To customize its behavior, do
+;; To customize its behavior, type
;; M-x bs-customize
;;; More Commentary:
-;; bs-show will generate a new buffer named *buffer-selection*, which shows
+;; `bs-show' will generate a new buffer named *buffer-selection*, which shows
;; all buffers or a subset of them, and has possibilities for deleting,
-;; saving and selecting buffers. For more details see docstring of
-;; function `bs-mode'. A current configuration describes which buffers appear
-;; in *buffer-selection*. See docstring of variable `bs-configurations' for
+;; saving and selecting buffers. For more details see docstring of
+;; function `bs-mode'. A current configuration describes which buffers appear
+;; in *buffer-selection*. See docstring of variable `bs-configurations' for
;; more details.
;;
;; The package bs combines the advantages of the Emacs functions
@@ -70,7 +70,7 @@
;;; Cycling through buffers
-;; This package offers two functions for buffer cycling. If you want to cycle
+;; This package offers two functions for buffer cycling. If you want to cycle
;; through buffer list you can use `bs-cycle-next' or `bs-cycle-previous'.
;; Bind these function to a key like
;; (global-set-key [(f9)] 'bs-cycle-previous)
@@ -80,7 +80,7 @@
;; to go through internal buffers like *Messages*.
;;
;; Cycling through buffers ignores sorting because sorting destroys
-;; the logical buffer list. If buffer list is sorted by size you
+;; the logical buffer list. If buffer list is sorted by size you
;; won't be able to cycle to the smallest buffer.
;;; Customization:
@@ -114,7 +114,7 @@
;; When cycling through buffer list the functions for cycling will use
;; the current configuration of bs to calculate the buffer list.
;; If you want to use a different configuration for cycling you have to set
-;; the variable `bs-cycle-configuration-name'. You can customize this variable.
+;; the variable `bs-cycle-configuration-name'. You can customize this
variable.
;;
;; For example: If you use the configuration called "files-and-scratch" you
;; can cycle through all file buffers and *scratch* although your current
@@ -390,9 +390,9 @@ column title to highlight.
FACE is a face used to fontify the sorted column title. A value of nil means
don't highlight.
The new sort aspect will be inserted into list `bs-sort-functions'."
- (let ((tupel (assoc name bs-sort-functions)))
- (if tupel
- (setcdr tupel (list fun regexp-for-sorting face))
+ (let ((tuple (assoc name bs-sort-functions)))
+ (if tuple
+ (setcdr tuple (list fun regexp-for-sorting face))
(setq bs-sort-functions
(cons (list name fun regexp-for-sorting face)
bs-sort-functions)))))
@@ -823,10 +823,14 @@ Leave Buffer Selection Menu."
"Visit the tags table in the buffer on this line.
See `visit-tags-table'."
(interactive)
- (let ((file (buffer-file-name (bs--current-buffer))))
- (if file
- (visit-tags-table file)
- (error "Specified buffer has no file"))))
+ (let* ((buf (bs--current-buffer))
+ (file (buffer-file-name buf)))
+ (cond
+ ((not file) (error "Specified buffer has no file"))
+ ((and buf (with-current-buffer buf
+ (etags-verify-tags-table)))
+ (visit-tags-table file))
+ (t (error "Specified buffer is not a tags-table")))))
(defun bs-toggle-current-to-show ()
"Toggle status of showing flag for buffer in current line."
@@ -1236,13 +1240,13 @@ by buffer configuration `bs-cycle-configuration-name'."
(bs-set-configuration (or bs-cycle-configuration-name
bs-default-configuration))
(let ((bs-buffer-sort-function nil)
(bs--current-sort-function nil))
- (let* ((tupel (bs-next-buffer (if (or (eq last-command
+ (let* ((tuple (bs-next-buffer (if (or (eq last-command
'bs-cycle-next)
(eq last-command
'bs-cycle-previous))
bs--cycle-list)))
- (next (car tupel))
- (cycle-list (cdr tupel)))
+ (next (car tuple))
+ (cycle-list (cdr tuple)))
;; We don't want the frame iconified if the only window in the frame
;; happens to be dedicated.
(bury-buffer (current-buffer))
@@ -1268,13 +1272,13 @@ by buffer configuration `bs-cycle-configuration-name'."
(bs-set-configuration (or bs-cycle-configuration-name
bs-default-configuration))
(let ((bs-buffer-sort-function nil)
(bs--current-sort-function nil))
- (let* ((tupel (bs-previous-buffer (if (or (eq last-command
+ (let* ((tuple (bs-previous-buffer (if (or (eq last-command
'bs-cycle-next)
(eq last-command
'bs-cycle-previous))
bs--cycle-list)))
- (prev-buffer (car tupel))
- (cycle-list (cdr tupel)))
+ (prev-buffer (car tuple))
+ (cycle-list (cdr tuple)))
(switch-to-buffer prev-buffer nil t)
(setq bs--cycle-list (append (last cycle-list)
(reverse (cdr (reverse cycle-list)))))
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
index abf152f058..aa5f70edf2 100644
--- a/lisp/buff-menu.el
+++ b/lisp/buff-menu.el
@@ -1,7 +1,6 @@
;;; buff-menu.el --- Interface for viewing and manipulating buffers -*-
lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1993-1995, 2000-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: convenience
@@ -101,6 +100,13 @@ as it is by default."
This is set by the prefix argument to `buffer-menu' and related
commands.")
+(defvar-local Buffer-menu-filter-predicate nil
+ "Function to filter out buffers in the buffer list.
+Buffers that don't satisfy the predicate will be skipped.
+The value should be a function of one argument; it will be
+called with the buffer. If this function returns non-nil,
+then the buffer will be displayed in the buffer list.")
+
(defvar-keymap Buffer-menu-mode-map
:doc "Local keymap for `Buffer-menu-mode' buffers."
:parent tabulated-list-mode-map
@@ -133,10 +139,12 @@ commands.")
"M-s a C-s" #'Buffer-menu-isearch-buffers
"M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp
"M-s a C-o" #'Buffer-menu-multi-occur
-
"<mouse-2>" #'Buffer-menu-mouse-select
"<follow-link>" 'mouse-face)
+(put 'Buffer-menu-delete :advertised-binding "d")
+(put 'Buffer-menu-this-window :advertised-binding "f")
+
(easy-menu-define Buffer-menu-mode-menu Buffer-menu-mode-map
"Menu for `Buffer-menu-mode' buffers."
'("Buffer-Menu"
@@ -236,6 +244,26 @@ In Buffer Menu mode, the following commands are defined:
(lambda (&optional _noconfirm) 'fast))
(add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t))
+(defun buffer-menu--display-help ()
+ (message "%s"
+ (substitute-command-keys
+ (concat
+ "Commands: "
+ "\\<Buffer-menu-mode-map>"
+ "\\[Buffer-menu-delete], "
+ "\\[Buffer-menu-save], "
+ "\\[Buffer-menu-execute], "
+ "\\[Buffer-menu-unmark]; "
+ "\\[Buffer-menu-this-window], "
+ "\\[Buffer-menu-other-window], "
+ "\\[Buffer-menu-1-window], "
+ "\\[Buffer-menu-2-window], "
+ "\\[Buffer-menu-mark], "
+ "\\[Buffer-menu-select]; "
+ "\\[Buffer-menu-not-modified], "
+ "\\[Buffer-menu-toggle-read-only]; "
+ "\\[quit-window] to quit; \\[describe-mode] for help"))))
+
(defun buffer-menu (&optional arg)
"Switch to the Buffer Menu.
By default, the Buffer Menu lists all buffers except those whose
@@ -261,8 +289,7 @@ the `Buffer-menu-name-width', `Buffer-menu-size-width' and
`Buffer-menu-mode-width' variables."
(interactive "P")
(switch-to-buffer (list-buffers-noselect arg))
- (message
- "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
+ (buffer-menu--display-help))
(defun buffer-menu-other-window (&optional arg)
"Display the Buffer Menu in another window.
@@ -273,8 +300,7 @@ with a space (which are for internal use). With prefix
argument
ARG, show only buffers that are visiting files."
(interactive "P")
(switch-to-buffer-other-window (list-buffers-noselect arg))
- (message
- "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
+ (buffer-menu--display-help))
;;;###autoload
(defun list-buffers (&optional arg)
@@ -597,19 +623,23 @@ This behaves like invoking \\[read-only-mode] in that
buffer."
;;; Functions for populating the Buffer Menu.
;;;###autoload
-(defun list-buffers-noselect (&optional files-only buffer-list)
+(defun list-buffers-noselect (&optional files-only buffer-list
filter-predicate)
"Create and return a Buffer Menu buffer.
This is called by `buffer-menu' and others as a subroutine.
If FILES-ONLY is non-nil, show only file-visiting buffers.
If BUFFER-LIST is non-nil, it should be a list of buffers; it
-means list those buffers and no others."
+means list those buffers and no others.
+If FILTER-PREDICATE is non-nil, it should be a function
+that filters out buffers from the list of buffers.
+See more at `Buffer-menu-filter-predicate'."
(let ((old-buffer (current-buffer))
(buffer (get-buffer-create "*Buffer List*")))
(with-current-buffer buffer
(Buffer-menu-mode)
(setq Buffer-menu-files-only
(and files-only (>= (prefix-numeric-value files-only) 0)))
+ (setq Buffer-menu-filter-predicate filter-predicate)
(list-buffers--refresh buffer-list old-buffer)
(tabulated-list-print))
buffer))
@@ -631,6 +661,8 @@ means list those buffers and no others."
(marked-buffers (Buffer-menu-marked-buffers))
(buffer-menu-buffer (current-buffer))
(show-non-file (not Buffer-menu-files-only))
+ (filter-predicate (and (functionp Buffer-menu-filter-predicate)
+ Buffer-menu-filter-predicate))
entries name-width)
;; Collect info for each buffer we're interested in.
(dolist (buffer (or buffer-list
@@ -644,7 +676,9 @@ means list those buffers and no others."
(and (or (not (string= (substring name 0 1) " "))
file)
(not (eq buffer buffer-menu-buffer))
- (or file show-non-file))))
+ (or file show-non-file)
+ (or (not filter-predicate)
+ (funcall filter-predicate buffer)))))
(push (list buffer
(vector (cond
((eq buffer old-buffer) ".")
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index a95967bef4..5735126bf5 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -1414,7 +1414,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(defun calc-gnuplot-command (&rest args)
"Send ARGS to Gnuplot.
-Returns nil if Gnuplot signalled an error."
+Returns nil if Gnuplot signaled an error."
(calc-graph-init)
(let ((cmd (concat (mapconcat 'identity args " ") "\n")))
(or (calc-graph-w32-p)
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
index 98e91aaa75..9a2baf1e43 100644
--- a/lisp/calendar/diary-lib.el
+++ b/lisp/calendar/diary-lib.el
@@ -92,7 +92,7 @@ are holidays."
This is used by `diary-pull-attrs' to fontify certain diary
elements. REGEXP is a regular expression to for, and SUBEXP is
the numbered sub-expression to extract. `diary-glob-file-regexp-prefix'
-is pre-pended to REGEXP for file-wide specifiers. ATTRIBUTE
+is prepended to REGEXP for file-wide specifiers. ATTRIBUTE
specifies which face attribute (e.g. `:foreground') to modify, or
that this is a face (`:face') to apply. TYPE is the type of
attribute being applied. Available TYPES (see `diary-attrtype-convert')
@@ -109,7 +109,7 @@ are: `string', `symbol', `int', `tnil', `stringtnil'."
:group 'diary)
(defcustom diary-glob-file-regexp-prefix "^#"
- "Regular expression pre-pended to `diary-face-attrs' for file-wide
specifiers."
+ "Regular expression prepended to `diary-face-attrs' for file-wide
specifiers."
:type 'regexp
:group 'diary)
@@ -1769,7 +1769,7 @@ These functions give the date in alternative calendrical
systems:
`diary-islamic-date', `diary-julian-date', `diary-mayan-date',
`diary-persian-date'
-Theses functions only produce output on certain dates:
+These functions only produce output on certain dates:
`diary-lunar-phases' - phases of moon (on the appropriate days)
`diary-hebrew-omer' - Omer count, within 50 days after Passover
diff --git a/lisp/cedet/ChangeLog.1 b/lisp/cedet/ChangeLog.1
index aa54bdd9b0..78275f4db3 100644
--- a/lisp/cedet/ChangeLog.1
+++ b/lisp/cedet/ChangeLog.1
@@ -459,7 +459,7 @@
* semantic/scope.el (semantic-analyze-scoped-types-default): If we
cannot find a type in the typecache, also look into the types
we already found. This is necessary since in C++, a 'using
- namespace' can be dependend on a previous one.
+ namespace' can be dependent on a previous one.
(semantic-completable-tags-from-type): When creating the list of
completable types, pull in types which are referenced through
'using' statements, and also preserve their filenames.
@@ -1546,7 +1546,7 @@
(ede-proj-makefile-dependencies): Update pattern rule so that
resulting parsers are also byte-compiled.
(semantic-ede-grammar-compiler-bovine)
- (semantic-ede-source-grammar-wisent): Remove .elc from gargage
+ (semantic-ede-source-grammar-wisent): Remove .elc from garbage
pattern, since this is already covered by the elisp compiler.
(project-compile-target): Add compatibility code for Emacs 23,
which does not have `byte-recompile-file'.
@@ -1915,10 +1915,9 @@
2011-05-10 Jim Meyering <meyering@redhat.com>
Fix doubled-word typos.
- * ede/pmake.el (ede-proj-makefile-garbage-patterns): the the -> the
+ * ede/pmake.el (ede-proj-makefile-garbage-patterns):
* semantic/complete.el (semantic-complete-read-tag-local-members):
- Likewise.
- * ede.el (ede-auto-add-method): then then -> then
+ * ede.el (ede-auto-add-method): Fix typos.
2011-04-23 Juanma Barranquero <lekktu@gmail.com>
@@ -3098,7 +3097,7 @@
* ede/proj-prog.el (project-run-target): New method.
* ede/proj-obj.el (ede-cc-linker): Rename from ede-gcc-linker.
- (ede-g++-linker): Change Change link lines.
+ (ede-g++-linker): Change link lines.
* ede/pmake.el (ede-pmake-insert-variable-shared):
When searching for old variables, go to the end of the buffer and
diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index e6bfd0b1e8..1118235757 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -598,7 +598,7 @@ an EDE controlled project."
"\\.#"
"~$"
)
- "List of file name patters that EDE will never ask about.")
+ "List of file name patterns that EDE will never ask about.")
(defun ede-ignore-file (filename)
"Should we ignore FILENAME?"
diff --git a/lisp/cedet/ede/locate.el b/lisp/cedet/ede/locate.el
index b9b1194ccc..3d89419364 100644
--- a/lisp/cedet/ede/locate.el
+++ b/lisp/cedet/ede/locate.el
@@ -172,7 +172,7 @@ You cannot create projects for the baseclass."
(defclass ede-locate-locate (ede-locate-base)
()
"EDE Locator using the locate command.
-Configure the Emacs `locate-program' variable to also
+Configure the Emacs `locate-command' variable to also
configure the use of EDE locate.")
(cl-defmethod ede-locate-ok-in-project ((_loc (subclass ede-locate-locate))
@@ -315,7 +315,7 @@ that created this EDE locate object."
()
"EDE Locator using Cscope.
Configure EDE's use of Cscope through the cedet-cscope.el
-file name searching variable `cedet-cscope-file-command'.")
+file name searching variable `cedet-cscope-command'.")
(cl-defmethod initialize-instance ((loc ede-locate-cscope)
&rest _slots)
diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el
index 1b424bc6d0..5aaa5b2687 100644
--- a/lisp/cedet/ede/makefile-edit.el
+++ b/lisp/cedet/ede/makefile-edit.el
@@ -35,7 +35,7 @@
;; SOURCE always keep in the order of .c, .h, the other stuff.
;;; Things to do
-;; makefile-fill-paragraph -- refill a macro w/ backslashes
+;; makefile-fill-paragraph -- refill a macro with backslashes
;; makefile-insert-macro -- insert "foo = "
diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el
index 7a486754a0..398e08a1a9 100644
--- a/lisp/cedet/ede/proj.el
+++ b/lisp/cedet/ede/proj.el
@@ -43,7 +43,7 @@
(autoload 'ede-proj-target-scheme "ede/proj-scheme"
"Target class for a group of lisp files." nil nil)
(autoload 'ede-proj-target-makefile-miscelaneous "ede/proj-misc"
- "Target class for a group of miscellaneous w/ a special makefile." nil nil)
+ "Target class for a group of miscellaneous with a special makefile." nil nil)
(autoload 'ede-proj-target-makefile-program "ede/proj-prog"
"Target class for building a program." nil nil)
(autoload 'ede-proj-target-makefile-archive "ede/proj-archive"
@@ -67,7 +67,7 @@
"Target class for a group of lisp files.")
(eieio-defclass-autoload 'ede-proj-target-makefile-miscelaneous
'(ede-proj-target-makefile)
"ede/proj-misc"
- "Target class for a group of miscellaneous w/ a special makefile.")
+ "Target class for a group of miscellaneous with a special makefile.")
(eieio-defclass-autoload 'ede-proj-target-makefile-program
'(ede-proj-target-makefile-objectcode)
"ede/proj-prog"
"Target class for building a program.")
@@ -543,7 +543,7 @@ Converts all symbols into the objects to be used."
(when (slot-exists-p obj 'compiler)
(let ((comp (oref obj compiler)))
(if comp
- ;; Now that we have a pre-set compilers to use, convert tye symbols
+ ;; Now that we have a pre-set compilers to use, convert type symbols
;; into objects for ease of use
(setq comp (if (listp comp)
(mapcar #'symbol-value comp)
diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el
index de6936ad1a..75fde2043c 100644
--- a/lisp/cedet/ede/project-am.el
+++ b/lisp/cedet/ede/project-am.el
@@ -195,7 +195,7 @@ other meta-variable based on this name.")
"Add the current buffer into a project.
_FILE is ignored.
OT is the object target. DIR is the directory to start in."
- (let* ((target (if ede-object (error "Already associated w/ a target")
+ (let* ((target (if ede-object (error "Already associated with a target")
(let ((amf (project-am-load default-directory)))
(if (not amf) (error "No project file"))
(completing-read "Target: "
@@ -231,7 +231,7 @@ OT is the object target. DIR is the directory to start in."
(setq ede-object nil))
(cl-defmethod project-edit-file-target ((obj project-am-target))
- "Edit the target associated w/ this file."
+ "Edit the target associated with this file."
(find-file (concat (oref obj path) "Makefile.am"))
(goto-char (point-min))
(makefile-move-to-macro (project-am-macro obj))
diff --git a/lisp/cedet/pulse.el b/lisp/cedet/pulse.el
index 0564cf6d04..5b0df013a3 100644
--- a/lisp/cedet/pulse.el
+++ b/lisp/cedet/pulse.el
@@ -47,7 +47,7 @@
;; The original pulse code was written for semantic tag highlighting.
;; It has been extracted, and adapted for general purpose pulsing.
;;
-;; Pulse is a part of CEDET. http://cedet.sf.net
+;; Pulse is a part of CEDET. https://cedet.sourceforge.net
(require 'color)
diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el
index 3166279de4..adb4705620 100644
--- a/lisp/cedet/semantic.el
+++ b/lisp/cedet/semantic.el
@@ -186,13 +186,13 @@ during a flush when the cache is given a new value of
nil.")
"State of the current parse tree.")
(defmacro semantic-parse-tree-unparseable ()
- "Indicate that the current buffer is unparseable.
+ "Indicate that the current buffer is unparsable.
It is also true that the parse tree will need either updating or
a rebuild. This state will be changed when the user edits the buffer."
'(setq semantic-parse-tree-state 'unparseable))
(defmacro semantic-parse-tree-unparseable-p ()
- "Return non-nil if the current buffer has been marked unparseable."
+ "Return non-nil if the current buffer has been marked unparsable."
'(eq semantic-parse-tree-state 'unparseable))
(defmacro semantic-parse-tree-set-needs-update ()
@@ -528,14 +528,14 @@ If the buffer cache is out of date, attempt an
incremental reparse.
If the buffer has not been parsed before, or if the incremental reparse
fails, then parse the entire buffer.
If a lexical error had been previously discovered and the buffer
-was marked unparseable, then do nothing, and return the cache."
+was marked unparsable, then do nothing, and return the cache."
(and
;; Is this a semantic enabled buffer?
(semantic-active-p)
;; Application hooks say the buffer is safe for parsing
(run-hook-with-args-until-failure
'semantic--before-fetch-tags-hook)
- ;; If the buffer was previously marked unparseable,
+ ;; If the buffer was previously marked unparsable,
;; then don't waste our time.
(not (semantic-parse-tree-unparseable-p))
;; The parse tree actually needs to be refreshed
@@ -606,7 +606,7 @@ Does nothing if the current buffer doesn't need reparsing."
;; do them here, then all the bovination hooks are not run, and
;; we save lots of time.
(cond
- ;; If the buffer was previously marked unparseable,
+ ;; If the buffer was previously marked unparsable,
;; then don't waste our time.
((semantic-parse-tree-unparseable-p)
nil)
diff --git a/lisp/cedet/semantic/analyze/fcn.el
b/lisp/cedet/semantic/analyze/fcn.el
index 7f60162115..ef372b5d8b 100644
--- a/lisp/cedet/semantic/analyze/fcn.el
+++ b/lisp/cedet/semantic/analyze/fcn.el
@@ -67,12 +67,12 @@ Return the string representing the compound name.")
"For a SEQUENCE of tags, all with good names, pick the best one.
If SEQUENCE is made up of namespaces, merge the namespaces together.
If SEQUENCE has several prototypes, find the non-prototype.
-If SEQUENCE has some items w/ no type information, find the one with a type.
+If SEQUENCE has some items with no type information, find the one with a type.
If SEQUENCE is all prototypes, or has no prototypes, get the first one.
Optional TAGCLASS indicates to restrict the return to only
tags of TAGCLASS."
- ;; If there is a srew up and we get just one tag.. massage over it.
+ ;; If there is a screw up and we get just one tag.. massage over it.
(when (semantic-tag-p sequence)
(setq sequence (list sequence)))
diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el
index d4ce20589e..5e08413a96 100644
--- a/lisp/cedet/semantic/bovine/c.el
+++ b/lisp/cedet/semantic/bovine/c.el
@@ -1344,7 +1344,7 @@ Optional argument STAR and REF indicate the number of *
and & in the typedef."
:reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t)
;; A function post-const is funky. Try stuff
:methodconst-flag (if (member "const" (nth 6 tokenpart)) t)
- ;; prototypes are functions w/ no body
+ ;; prototypes are functions with no body
:prototype-flag (if (nth 8 tokenpart) t)
;; Pure virtual
:pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t)
@@ -2015,7 +2015,7 @@ have to be wrapped in that namespace."
(setq txt (concat txt (format "%S" arg)))
(setq sv (cdr sv)))
- ;; This is optional, and potentially fraught w/ errors.
+ ;; This is optional, and potentially fraught with errors.
(condition-case nil
(dolist (lt sv)
(setq txt (concat txt " " (semantic-lex-token-text lt))))
diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el
index dc270603a0..00fe081acb 100644
--- a/lisp/cedet/semantic/complete.el
+++ b/lisp/cedet/semantic/complete.el
@@ -667,7 +667,7 @@ Similar to `minibuffer-contents' when completing in the
minibuffer."
)
(delete-overlay semantic-complete-inline-overlay)
(setq semantic-complete-inline-overlay nil)
- ;; DONT restore the window configuration if we just
+ ;; DON'T restore the window configuration if we just
;; switched windows!
(when (eq buf (current-buffer))
(set-window-configuration wc))
diff --git a/lisp/cedet/semantic/db-ebrowse.el
b/lisp/cedet/semantic/db-ebrowse.el
index f0e1d9f029..fa608c7c46 100644
--- a/lisp/cedet/semantic/db-ebrowse.el
+++ b/lisp/cedet/semantic/db-ebrowse.el
@@ -275,7 +275,7 @@ For instance:
/home/<username>/.semanticdb/!usr!include!BROWSE"
(let ((ans nil)
(efcn (symbol-function 'ebrowse-show-progress)))
(fset 'ebrowse-show-progress (lambda (&rest _junk) nil))
- (unwind-protect ;; Protect against errors w/ ebrowse
+ (unwind-protect ; Protect against errors with ebrowse
(setq ans (list B (ebrowse-read)))
;; These items must always happen
(erase-buffer)
diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el
index 3012af41c5..e9d5aaa177 100644
--- a/lisp/cedet/semantic/db-find.el
+++ b/lisp/cedet/semantic/db-find.el
@@ -1277,7 +1277,7 @@ associated with that tag should be loaded into a buffer."
;;; Specialty Search Routines
(defun semanticdb-find-tags-external-children-of-type
(type &optional path find-file-match)
- "Search for all tags defined outside of TYPE w/ TYPE as a parent.
+ "Search for all tags defined outside of TYPE with TYPE as a parent.
See `semanticdb-find-translate-path' for details on PATH.
FIND-FILE-MATCH indicates that any time a match is found, the file
associated with that tag should be loaded into a buffer."
diff --git a/lisp/cedet/semantic/decorate/include.el
b/lisp/cedet/semantic/decorate/include.el
index 144e2ce018..fe510c371e 100644
--- a/lisp/cedet/semantic/decorate/include.el
+++ b/lisp/cedet/semantic/decorate/include.el
@@ -330,7 +330,7 @@ This mode provides a nice context menu on the include
statements."
)
))
- ;; @TODO - if not a tag w/ a position, we need to get one. How?
+ ;; @TODO - if not a tag with a position, we need to get one. How?
(when (semantic-tag-with-position-p tag)
(let ((ol (semantic-decorate-tag tag
diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el
index 7cb6768f7e..d752ecdf38 100644
--- a/lisp/cedet/semantic/edit.el
+++ b/lisp/cedet/semantic/edit.el
@@ -40,7 +40,7 @@
;; of themselves that can be edited w/out affecting the definition of
;; that tag.
;;
-;; 2. Tags w/ positioned children could have a property of an
+;; 2. Tags with positioned children could have a property of an
;; overlay marking the region in themselves that contain the
;; children. This could be used to better improve splicing near
;; the beginning and end of the child lists.
@@ -128,11 +128,9 @@ If nil, errors are still displayed, but informative
messages are not."
"Provide a mechanism for semantic tag management.
Argument START, END, and LENGTH specify the bounds of the change."
(setq semantic-unmatched-syntax-cache-check t)
- (let ((inhibit-point-motion-hooks t)
- )
- (save-match-data
- (run-hook-with-args 'semantic-change-functions start end length)
- )))
+ (save-match-data
+ (run-hook-with-args 'semantic-change-functions start end length)
+ ))
(defun semantic-changes-in-region (start end &optional buffer)
"Find change overlays which exist in whole or in part between START and END.
diff --git a/lisp/cedet/semantic/grm-wy-boot.el
b/lisp/cedet/semantic/grm-wy-boot.el
index 376fab89c2..7fff36a3d0 100644
--- a/lisp/cedet/semantic/grm-wy-boot.el
+++ b/lisp/cedet/semantic/grm-wy-boot.el
@@ -396,12 +396,12 @@
(let
((s $1))
(if
- (string-match "^{[
\n ]*" s)
+ (string-match "^{[\^M\n ]*" s)
(setq s
(substring s
(match-end 0))))
(if
- (string-match "[
\n ]*}$" s)
+ (string-match "[\^M\n ]*}$" s)
(setq s
(substring s 0
(match-beginning 0))))
diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el
index 2d6f26919d..e53dd9104a 100644
--- a/lisp/cedet/semantic/idle.el
+++ b/lisp/cedet/semantic/idle.el
@@ -396,7 +396,7 @@ Uses `semantic-idle-work-for-on-buffer' to do the work."
(semanticdb-save-all-db-idle)
)
- ;; Done w/ processing
+ ;; Done with processing
nil))))
;; Done
diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el
index 83e7ed66c1..45964a1a17 100644
--- a/lisp/cedet/semantic/scope.el
+++ b/lisp/cedet/semantic/scope.el
@@ -577,7 +577,7 @@ such as `public' or `private'."
(if (semantic-tag-file-name TAG)
;; If it has a filename, just go with it...
(setq copyslots (cons TAG copyslots))
- ;; Otherwise, copy the tag w/ the guessed filename.
+ ;; Otherwise, copy the tag with the guessed filename.
(setq copyslots (cons (semantic-tag-copy TAG nil fname)
copyslots)))
)
@@ -822,7 +822,7 @@ hits in order, with the first tag being in the closest
scope."
ans)
;; Not a real scope. Our scope calculation analyze parts of
;; what it finds, and needs to pass lists through to do it's work.
- ;; Tread that list as a singly entry.
+ ;; Treat that list as a singly entry.
(if class
(semantic-find-tags-by-class class scope)
scope)
diff --git a/lisp/cedet/semantic/symref/grep.el
b/lisp/cedet/semantic/symref/grep.el
index 27ea80fc32..076775bfec 100644
--- a/lisp/cedet/semantic/symref/grep.el
+++ b/lisp/cedet/semantic/symref/grep.el
@@ -139,6 +139,8 @@ This shell should support pipe redirect syntax."
(lambda (s) (concat "\\" s))
string nil t))
+(defvar semantic-symref-grep--local-dir nil)
+
(cl-defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep))
"Perform a search with Grep."
;; Grep doesn't support some types of searches.
@@ -170,11 +172,12 @@ This shell should support pipe redirect syntax."
(erase-buffer)
(setq default-directory rootdir)
(let ((cmd (semantic-symref-grep-use-template
- (directory-file-name (file-local-name rootdir))
+ "."
filepattern grepflags greppat)))
(process-file semantic-symref-grep-shell nil b nil
shell-command-switch cmd)))
- (setq ans (semantic-symref-parse-tool-output tool b))
+ (let ((semantic-symref-grep--local-dir (directory-file-name
(file-local-name rootdir))))
+ (setq ans (semantic-symref-parse-tool-output tool b)))
;; Return the answer
ans))
@@ -190,12 +193,12 @@ Moves cursor to end of the match."
((eq (oref tool resulttype) 'line-and-text)
(when (re-search-forward grep-re nil t)
(list (string-to-number (match-string line-group))
- (match-string file-group)
+ (concat semantic-symref-grep--local-dir (substring
(match-string file-group) 1))
(buffer-substring-no-properties (point)
(line-end-position)))))
(t
(when (re-search-forward grep-re nil t)
(cons (string-to-number (match-string line-group))
- (match-string file-group))
+ (concat semantic-symref-grep--local-dir (substring
(match-string file-group) 1)))
)))))
(provide 'semantic/symref/grep)
diff --git a/lisp/cedet/semantic/symref/list.el
b/lisp/cedet/semantic/symref/list.el
index eacbb6f1f8..1cb5d5b04a 100644
--- a/lisp/cedet/semantic/symref/list.el
+++ b/lisp/cedet/semantic/symref/list.el
@@ -51,7 +51,7 @@ Display the references in `semantic-symref-results-mode'."
(let ((ct (semantic-current-tag)))
;; Must have a tag...
(when (not ct) (error "Place cursor inside tag to be searched for"))
- ;; Check w/ user.
+ ;; Check with user.
(when (not (y-or-n-p (format "Find references for %s? "
(semantic-tag-name ct))))
(error "Quit"))
@@ -378,7 +378,8 @@ BUTTON is the button that was clicked."
(defun semantic-symref-list-on-hit-p ()
"Return the line number if the cursor is on a buffer line with a hit.
-Hits are the line of code from the buffer, not the tag summar or file lines."
+Hits are the line of code from the buffer, not the tag summary or
+file lines."
(save-excursion
(end-of-line)
(let* ((ol (car (overlays-at (1- (point)))))) ;; trust this for now
diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el
index 16695a108a..aa5b17e9bb 100644
--- a/lisp/cedet/semantic/tag.el
+++ b/lisp/cedet/semantic/tag.el
@@ -1176,7 +1176,7 @@ This function is for internal use only."
(defsubst semantic--tag-expanded-p (tag)
"Return non-nil if TAG is expanded.
This function is for internal use only.
-See also the function `semantic--expand-tag'."
+See also the function `semantic--tag-expand'."
;; In fact a cooked tag is actually a list of cooked tags
;; because a raw tag can be expanded in several cooked ones!
(when (consp tag)
diff --git a/lisp/cedet/semantic/util-modes.el
b/lisp/cedet/semantic/util-modes.el
index 96d1de5a26..bcded23aec 100644
--- a/lisp/cedet/semantic/util-modes.el
+++ b/lisp/cedet/semantic/util-modes.el
@@ -133,7 +133,7 @@ symbol whose value is such a string."
semantic-minor-mode-alist))))
(semantic-mode-line-update)
- ;; Semantic minor modes don't work w/ Desktop restore.
+ ;; Semantic minor modes don't work with Desktop restore.
;; This line will disable this minor mode from being restored
;; by Desktop.
(when (boundp 'desktop-minor-mode-handlers)
diff --git a/lisp/cedet/semantic/wisent.el b/lisp/cedet/semantic/wisent.el
index 55eeef453e..b13dc99456 100644
--- a/lisp/cedet/semantic/wisent.el
+++ b/lisp/cedet/semantic/wisent.el
@@ -38,7 +38,7 @@
(defvar wisent-lex-lookahead nil
"Extra lookahead token.
-When non-nil it is directly returned by `wisent-lex-function'.")
+When non-nil it is directly returned by `wisent-lexer-function'.")
(defmacro wisent-lex-eoi ()
"Return an End-Of-Input lexical token.
diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el
index a25d1441f1..c264ebaa70 100644
--- a/lisp/cedet/srecode/document.el
+++ b/lisp/cedet/srecode/document.el
@@ -29,7 +29,8 @@
;;
;;; Origins:
;;
-;; Document was first written w/ cparse, a custom regexp based c parser.
+;; Document was first written with cparse, a custom regexp based c
+;; parser.
;;
;; Document was then ported to cedet/semantic using sformat (super
;; format) as the templating engine.
diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el
index 7d4539dcb4..f218f1c6e9 100644
--- a/lisp/cedet/srecode/extract.el
+++ b/lisp/cedet/srecode/extract.el
@@ -219,7 +219,7 @@ Return nil if nothing was extracted."
;; With a name, do the insertion.
(let ((subdict (srecode-dictionary-add-section-dictionary
dict (oref ins object-name))))
- (error "Need to implement include w/ name extractor")
+ (error "Need to implement include with name extractor")
;; Recurse into the new template while no errors.
(while (condition-case nil
(progn
diff --git a/lisp/cedet/srecode/fields.el b/lisp/cedet/srecode/fields.el
index 2fc79d01a7..67ee82c73e 100644
--- a/lisp/cedet/srecode/fields.el
+++ b/lisp/cedet/srecode/fields.el
@@ -334,9 +334,7 @@ START and END are the bounds of the change.
PRE-LEN is used in the after mode for the length of the changed text."
(when (and after (not undo-in-progress))
(let* ((field (overlay-get ol 'srecode))
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- )
+ (inhibit-modification-hooks t))
;; Sometimes a field is deleted, but we might still get a stray
;; event. Let's just ignore those events.
(when (slot-boundp field 'overlay)
diff --git a/lisp/cedet/srecode/insert.el b/lisp/cedet/srecode/insert.el
index db17b7f23f..f8cfe2a733 100644
--- a/lisp/cedet/srecode/insert.el
+++ b/lisp/cedet/srecode/insert.el
@@ -125,9 +125,7 @@ has set everything up already."
;; I tried `combine-after-change-calls', but it did not have
;; the effect I wanted.
(let ((start (point)))
- (let ((inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- )
+ (let ((inhibit-modification-hooks t))
(srecode--insert-into-buffer template dictionary)
)
;; Now call those after change functions.
diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el
index ea7fda004e..c5ceb89d2d 100644
--- a/lisp/cedet/srecode/semantic.el
+++ b/lisp/cedet/srecode/semantic.el
@@ -43,8 +43,8 @@
;;; The SEMANTIC TAG inserter
;;
-;; Put a tag into the dictionary that can be used w/ arbitrary
-;; lisp expressions.
+;; Put a tag into the dictionary that can be used with arbitrary
+;; Lisp expressions.
(defclass srecode-semantic-tag (srecode-dictionary-compound-value)
((prime :initarg :prime
diff --git a/lisp/comint.el b/lisp/comint.el
index b1f3ad8259..93b97cb22b 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -604,6 +604,14 @@ via PTYs.")
menu-bar-final-items))
map))
+(defvar-keymap comint-repeat-map
+ :doc "Keymap to repeat comint key sequences. Used in `repeat-mode'."
+ "C-n" #'comint-next-prompt
+ "C-p" #'comint-previous-prompt)
+
+(put #'comint-next-prompt 'repeat-map 'comint-repeat-map)
+(put #'comint-previous-prompt 'repeat-map 'comint-repeat-map)
+
;; Fixme: Is this still relevant?
(defvar comint-ptyp t
"Non-nil if communications via pty; false if by pipe. Buffer local.
@@ -2147,29 +2155,33 @@ Make backspaces delete the previous character."
(goto-char (process-mark process))
(set-marker comint-last-output-start (point))
+ ;; Before we call `comint--mark-as-output' later,
+ ;; redisplay can be called. We mark the inserted text as
+ ;; output early, to prevent redisplay from fontifying it
+ ;; as input in case of `comint-fontify-input-mode'.
+ (put-text-property 0 (length string) 'field 'output string)
+
;; insert-before-markers is a bad thing. XXX
;; Luckily we don't have to use it any more, we use
;; window-point-insertion-type instead.
- (make-local-variable 'jit-lock-mode)
- (let ((jit-lock-mode nil))
- (insert string)
+ (insert string)
- ;; Advance process-mark
- (set-marker (process-mark process) (point))
+ ;; Advance process-mark
+ (set-marker (process-mark process) (point))
- (unless comint-inhibit-carriage-motion
+ (unless comint-inhibit-carriage-motion
;; Interpret any carriage motion characters (newline, backspace)
(comint-carriage-motion comint-last-output-start (point)))
- ;; Run these hooks with point where the user had it.
- (goto-char saved-point)
- (run-hook-with-args 'comint-output-filter-functions string)
- (set-marker saved-point (point))
+ ;; Run these hooks with point where the user had it.
+ (goto-char saved-point)
+ (run-hook-with-args 'comint-output-filter-functions string)
+ (set-marker saved-point (point))
- (goto-char (process-mark process)) ; In case a filter moved it.
+ (goto-char (process-mark process)) ; In case a filter moved it.
- (unless comint-use-prompt-regexp
- (comint--mark-as-output comint-last-output-start (point))))
+ (unless comint-use-prompt-regexp
+ (comint--mark-as-output comint-last-output-start (point)))
;; Highlight the prompt, where we define `prompt' to mean
;; the most recent output that doesn't end with a newline.
diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el
index ee32c9c945..00ee9504c2 100644
--- a/lisp/cus-edit.el
+++ b/lisp/cus-edit.el
@@ -1,7 +1,7 @@
;;; cus-edit.el --- tools for customizing Emacs and Lisp packages -*-
lexical-binding:t -*-
-;;
-;; Copyright (C) 1996-1997, 1999-2022 Free Software Foundation, Inc.
-;;
+
+;; Copyright (C) 1996-2022 Free Software Foundation, Inc.
+
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: help, faces
@@ -23,7 +23,7 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;;
+
;; This file implements the code to create and edit customize buffers.
;;
;; See `custom.el'.
@@ -428,32 +428,30 @@ Use group `text' for this instead. This group is
deprecated."
;;; Custom mode keymaps
-(defvar custom-mode-map
- (let ((map (make-keymap)))
- (set-keymap-parent map widget-keymap)
- (define-key map [remap self-insert-command] 'Custom-no-edit)
- (define-key map "\^m" 'Custom-newline)
- (define-key map " " 'scroll-up-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map "\177" 'scroll-down-command)
- (define-key map "\C-c\C-c" 'Custom-set)
- (define-key map "\C-x\C-s" 'Custom-save)
- (define-key map "q" 'Custom-buffer-done)
- (define-key map "u" 'Custom-goto-parent)
- (define-key map "n" 'widget-forward)
- (define-key map "p" 'widget-backward)
- (define-key map "H" 'custom-toggle-hide-all-widgets)
- map)
- "Keymap for `Custom-mode'.")
-
-(defvar custom-mode-link-map
- (let ((map (make-keymap)))
- (set-keymap-parent map custom-mode-map)
- (define-key map [down-mouse-2] nil)
- (define-key map [down-mouse-1] 'mouse-drag-region)
- (define-key map [mouse-2] 'widget-move-and-invoke)
- map)
- "Local keymap for links in `Custom-mode'.")
+(defvar-keymap custom-mode-map
+ :doc "Keymap for `Custom-mode'."
+ :full t
+ :parent widget-keymap
+ "<remap> <self-insert-command>" #'Custom-no-edit
+ "RET" #'Custom-newline
+ "SPC" #'scroll-up-command
+ "S-SPC" #'scroll-down-command
+ "DEL" #'scroll-down-command
+ "C-c C-c" #'Custom-set
+ "C-x C-s" #'Custom-save
+ "q" #'Custom-buffer-done
+ "u" #'Custom-goto-parent
+ "n" #'widget-forward
+ "p" #'widget-backward
+ "H" #'custom-toggle-hide-all-widgets)
+
+(defvar-keymap custom-mode-link-map
+ :doc "Local keymap for links in `Custom-mode'."
+ :full t
+ :parent custom-mode-map
+ "<down-mouse-2>" nil
+ "<down-mouse-1>" #'mouse-drag-region
+ "<mouse-2>" #'widget-move-and-invoke)
(defvar custom-field-keymap
(let ((map (copy-keymap widget-field-keymap)))
@@ -1546,7 +1544,7 @@ If TYPE is `groups', include only groups."
"*Customize Apropos*")))
;;;###autoload
-(defun customize-apropos-options (regexp &optional ignored)
+(defun customize-apropos-options (regexp &optional _ignored)
"Customize all loaded customizable options matching REGEXP."
(interactive (list (apropos-read-pattern "options")))
(customize-apropos regexp 'options))
diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el
index 1df2ab8db7..69ed2087a7 100644
--- a/lisp/cus-theme.el
+++ b/lisp/cus-theme.el
@@ -32,17 +32,15 @@
(eval-when-compile
(require 'wid-edit))
-(defvar custom-new-theme-mode-map
- (let ((map (make-keymap)))
- (set-keymap-parent map (make-composed-keymap widget-keymap
- special-mode-map))
- (suppress-keymap map)
- (define-key map "\C-x\C-s" 'custom-theme-write)
- (define-key map "q" 'Custom-buffer-done)
- (define-key map "n" 'widget-forward)
- (define-key map "p" 'widget-backward)
- map)
- "Keymap for `custom-new-theme-mode'.")
+(defvar-keymap custom-new-theme-mode-map
+ :doc "Keymap for `custom-new-theme-mode'."
+ :full t
+ :suppress t
+ :parent (make-composed-keymap widget-keymap special-mode-map)
+ "C-x C-s" #'custom-theme-write
+ "q" #'Custom-buffer-done
+ "n" #'widget-forward
+ "p" #'widget-backward)
(define-derived-mode custom-new-theme-mode nil "Custom-Theme"
"Major mode for editing Custom themes.
@@ -146,7 +144,7 @@ remove them from your saved Custom file.\n\n")
(widget-create 'push-button
:tag " Revert "
:help-echo "Revert this buffer to its original state."
- :action (lambda (&rest ignored) (revert-buffer)))
+ :action (lambda (&rest _ignored) (revert-buffer)))
(widget-insert "\n\nTheme name : ")
(setq custom-theme-name
@@ -538,17 +536,15 @@ It includes all faces in list FACES."
:type 'boolean
:group 'custom-buffer)
-(defvar custom-theme-choose-mode-map
- (let ((map (make-keymap)))
- (set-keymap-parent map (make-composed-keymap widget-keymap
- special-mode-map))
- (suppress-keymap map)
- (define-key map "\C-x\C-s" 'custom-theme-save)
- (define-key map "n" 'widget-forward)
- (define-key map "p" 'widget-backward)
- (define-key map "?" 'custom-describe-theme)
- map)
- "Keymap for `custom-theme-choose-mode'.")
+(defvar-keymap custom-theme-choose-mode-map
+ :doc "Keymap for `custom-theme-choose-mode'."
+ :full t
+ :suppress t
+ :parent (make-composed-keymap widget-keymap special-mode-map)
+ "C-x C-s" #'custom-theme-save
+ "n" #'widget-forward
+ "p" #'widget-backward
+ "?" #'custom-describe-theme)
(define-derived-mode custom-theme-choose-mode special-mode "Themes"
"Major mode for selecting Custom themes.
diff --git a/lisp/custom.el b/lisp/custom.el
index 604b1a3ff4..0d3e2e5d0c 100644
--- a/lisp/custom.el
+++ b/lisp/custom.el
@@ -1152,9 +1152,11 @@ list, in which A occurs before B if B was defined with a
;; (provide-theme 'THEME)
-(defmacro deftheme (theme &optional doc)
+(defmacro deftheme (theme &optional doc &rest properties)
"Declare THEME to be a Custom theme.
The optional argument DOC is a doc string describing the theme.
+PROPERTIES are interpreted as a property list that will be stored
+in the `theme-properties' property for THEME.
Any theme `foo' should be defined in a file called `foo-theme.el';
see `custom-make-theme-feature' for more information."
@@ -1164,18 +1166,25 @@ see `custom-make-theme-feature' for more information."
;; It is better not to use backquote in this file,
;; because that makes a bootstrapping problem
;; if you need to recompile all the Lisp files using interpreted code.
- (list 'custom-declare-theme (list 'quote theme) (list 'quote feature)
doc)))
+ (list 'custom-declare-theme (list 'quote theme) (list 'quote feature) doc
+ (cons 'list properties))))
-(defun custom-declare-theme (theme feature &optional doc)
+(defun custom-declare-theme (theme feature &optional doc properties)
"Like `deftheme', but THEME is evaluated as a normal argument.
-FEATURE is the feature this theme provides. Normally, this is a symbol
-created from THEME by `custom-make-theme-feature'."
+FEATURE is the feature this theme provides. Normally, this is a
+symbol created from THEME by `custom-make-theme-feature'. The
+optional argument DOC may contain the documentation for THEME.
+The optional argument PROPERTIES may contain a property list of
+attributes associated with THEME."
(unless (custom-theme-name-valid-p theme)
(error "Custom theme cannot be named %S" theme))
(unless (memq theme custom-known-themes)
(push theme custom-known-themes))
(put theme 'theme-feature feature)
- (when doc (put theme 'theme-documentation doc)))
+ (when doc
+ (put theme 'theme-documentation doc))
+ (when properties
+ (put theme 'theme-properties properties)))
(defun custom-make-theme-feature (theme)
"Given a symbol THEME, create a new symbol by appending \"-theme\".
@@ -1372,6 +1381,58 @@ Return t if THEME was successfully loaded, nil
otherwise."
(enable-theme theme))
t)
+(defun theme-list-variants (theme &rest list)
+ "Return a list of theme variants for THEME.
+By default this will use all known custom themes (see
+`custom-available-themes') to check for variants. This can be
+restricted if the optional argument LIST containing a list of
+theme symbols to consider."
+ (let* ((properties (get theme 'theme-properties))
+ (family (plist-get properties :family)))
+ (seq-filter
+ (lambda (variant)
+ (and (eq (plist-get (get variant 'theme-properties) :family)
+ family)
+ (not (eq variant theme))))
+ (or list (custom-available-themes)))))
+
+(defun theme-choose-variant (&optional no-confirm no-enable)
+ "Switch from the current theme to one of its variants.
+The current theme will be disabled before variant is enabled. If
+the current theme has only one variant, switch to that variant
+without prompting, otherwise prompt for the variant to select.
+See `load-theme' for the meaning of NO-CONFIRM and NO-ENABLE."
+ (interactive)
+ (let ((active-color-schemes
+ (seq-filter
+ (lambda (theme)
+ ;; FIXME: As most themes currently do not have a `:kind'
+ ;; tag, it is assumed that a theme is a color scheme by
+ ;; default. This should be reconsidered in the future.
+ (memq (plist-get (get theme 'theme-properties) :kind)
+ '(color-scheme nil)))
+ custom-enabled-themes)))
+ (cond
+ ((length= active-color-schemes 0)
+ (user-error "No theme is active, cannot toggle"))
+ ((length> active-color-schemes 1)
+ (user-error "More than one theme active, cannot unambiguously toggle")))
+ (let* ((theme (car active-color-schemes))
+ (family (plist-get (get theme 'theme-properties) :family)))
+ (unless family
+ (error "Theme `%s' does not have any known variants" theme))
+ (let* ((variants (theme-list-variants theme))
+ (choice (cond
+ ((null variants)
+ (error "`%s' has no variants" theme))
+ ((length= variants 1)
+ (car variants))
+ ((intern (completing-read "Load custom theme: "
variants))))))
+ (disable-theme theme)
+ (load-theme choice no-confirm no-enable)))))
+
+(defalias 'toggle-theme #'theme-choose-variant)
+
(defun custom-theme-load-confirm (hash)
"Query the user about loading a Custom theme that may not be safe.
The theme should be in the current buffer. If the user agrees,
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
index 215425f136..e909da3c20 100644
--- a/lisp/dabbrev.el
+++ b/lisp/dabbrev.el
@@ -985,9 +985,6 @@ Leaves point at the location of the start of the expansion."
"\\(" dabbrev--abbrev-char-regexp "\\)"))
(pattern2 (concat (regexp-quote abbrev)
"\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)"))
- ;; This makes it possible to find matches in minibuffer prompts
- ;; even when they are "inviolable".
- (inhibit-point-motion-hooks t)
found-string result)
;; Limited search.
(save-restriction
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 9add96c260..5e1745069f 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1025,8 +1025,9 @@ If PROGRAM exits successfully, display \"MSG...done\" and
return nil.
If PROGRAM exits abnormally, save in `dired-log-buffer' the command
that invoked PROGRAM and the messages it emitted, and return either
the offending ARGUMENTS or PROGRAM if no ARGUMENTS were provided."
- (let (err-buffer err (dir default-directory))
- (message "%s..." msg)
+ (let ((dir default-directory)
+ (reporter (make-progress-reporter msg))
+ err-buffer err)
(save-excursion
;; Get a clean buffer for error output:
(setq err-buffer (get-buffer-create " *dired-check-process output*"))
@@ -1041,8 +1042,8 @@ the offending ARGUMENTS or PROGRAM if no ARGUMENTS were
provided."
(dired-log err-buffer)
(or arguments program t))
(kill-buffer err-buffer)
- (message "%s...done" msg)
- nil))))
+ (progress-reporter-done reporter)
+ nil))))
(defun dired-shell-command (cmd)
"Run CMD, and check for output.
@@ -3478,7 +3479,7 @@ Use \\[dired-hide-all] to (un)hide all directories."
(dired-next-subdir 1 t))))
;;;###autoload
-(defun dired-hide-all (&optional ignored)
+(defun dired-hide-all (&optional _ignored)
"Hide all subdirectories, leaving only their header lines.
If there is already something hidden, make everything visible again.
Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
@@ -3718,9 +3719,9 @@ function works."
;;;###autoload
(defun dired-show-file-type (file &optional deref-symlinks)
"Print the type of FILE, according to the `file' command.
-If you give a prefix to this command, and FILE is a symbolic
-link, then the type of the file linked to by FILE is printed
-instead."
+If you give a prefix argument \\[universal-argument] to this command, and
+FILE is a symbolic link, then the command will print the type
+of the target of the link instead."
(interactive (list (dired-get-filename t) current-prefix-arg))
(let (process-file-side-effects)
(with-temp-buffer
diff --git a/lisp/dired.el b/lisp/dired.el
index 96b580d576..81e62f88cf 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1457,9 +1457,9 @@ wildcards, erases the buffer, and builds the subdir-alist
anew
(if (eq (car attributes) t)
(set-visited-file-modtime (file-attribute-modification-time
attributes))))
- (set-buffer-modified-p nil)
(when dired-make-directory-clickable
(dired--make-directory-clickable))
+ (set-buffer-modified-p nil)
;; No need to narrow since the whole buffer contains just
;; dired-readin's output, nothing else. The hook can
;; successfully use dired functions (e.g. dired-get-filename)
@@ -1541,7 +1541,7 @@ BEG..END is the line where the file info is located."
(when (< alt-col other-col)
(setq other-col alt-col)
(setq other (point)))))
- ;; Keep positions uptodate when we insert stuff.
+ ;; Keep positions up-to-date when we insert stuff.
(if (> other file) (setq other (copy-marker other)))
(setq file (copy-marker file))
;; Main loop.
@@ -1911,11 +1911,15 @@ mouse-2: visit this file in other window"
(defun dired--make-directory-clickable ()
(save-excursion
(goto-char (point-min))
- (while (re-search-forward "^ /" nil t 1)
+ (while (re-search-forward
+ (if (memq system-type '(windows-nt ms-dos))
+ "^ \\([a-zA-Z]:/\\|//\\)"
+ "^ /")
+ nil t 1)
(let ((bound (line-end-position))
(segment-start (point))
(inhibit-read-only t)
- (dir "/"))
+ (dir (substring (match-string 0) 2)))
(while (search-forward "/" bound t 1)
(setq dir (concat dir (buffer-substring segment-start (point))))
(add-text-properties
@@ -2956,7 +2960,7 @@ unchanged."
(or dir (setq dir default-directory))
;; This case comes into play if default-directory is set to
;; use ~.
- (if (and (> (length dir) 0) (= (aref dir 0) ?~))
+ (if (string-match-p "\\(\\`\\|:\\)~" dir)
(setq dir (expand-file-name dir)))
(if (string-match (concat "^" (regexp-quote dir)) file)
(substring file (match-end 0))
@@ -3024,13 +3028,13 @@ See options: `dired-hide-details-hide-symlink-targets'
and
;; The old code used selective-display which only works at
;; a line-granularity, so it used start and end positions that where
;; approximate ("anywhere on the line is fine").
- ;; FIXME: This also removes other invisible properties!
(save-excursion
(let ((inhibit-read-only t))
(remove-list-of-text-properties
(progn (goto-char start) (line-end-position))
(progn (goto-char end) (line-end-position))
- '(invisible)))))
+ '(invisible))
+ (dired-insert-set-properties start end))))
;;; Functions for finding the file name in a dired buffer line
diff --git a/lisp/dnd.el b/lisp/dnd.el
index b2e93a63de..7708695346 100644
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -325,7 +325,7 @@ in that list instead."
(defun dnd-begin-text-drag (text &optional frame action allow-same-frame)
"Begin dragging TEXT from FRAME.
-Initate a drag-and-drop operation allowing the user to drag text
+Initiate a drag-and-drop operation allowing the user to drag text
from Emacs to another program (the drop target), then block until
the drop is completed or is canceled.
@@ -381,7 +381,7 @@ currently being held down. It should only be called upon a
(defun dnd-begin-file-drag (file &optional frame action allow-same-frame)
"Begin dragging FILE from FRAME.
-Initate a drag-and-drop operation allowing the user to drag a file
+Initiate a drag-and-drop operation allowing the user to drag a file
from Emacs to another program (the drop target), then block until
the drop happens or is canceled.
diff --git a/lisp/dom.el b/lisp/dom.el
index f8c794a300..01bdef3a07 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -30,23 +30,17 @@
(defsubst dom-tag (node)
"Return the NODE tag."
;; Called on a list of nodes. Use the first.
- (if (consp (car node))
- (caar node)
- (car node)))
+ (car (if (consp (car node)) (car node) node)))
(defsubst dom-attributes (node)
"Return the NODE attributes."
;; Called on a list of nodes. Use the first.
- (if (consp (car node))
- (cadr (car node))
- (cadr node)))
+ (cadr (if (consp (car node)) (car node) node)))
(defsubst dom-children (node)
"Return the NODE children."
;; Called on a list of nodes. Use the first.
- (if (consp (car node))
- (cddr (car node))
- (cddr node)))
+ (cddr (if (consp (car node)) (car node) node)))
(defun dom-non-text-children (node)
"Return all non-text-node children of NODE."
@@ -62,10 +56,11 @@
(defun dom-set-attribute (node attribute value)
"Set ATTRIBUTE in NODE to VALUE."
(setq node (dom-ensure-node node))
- (let ((old (assoc attribute (cadr node))))
+ (let* ((attributes (cadr node))
+ (old (assoc attribute attributes)))
(if old
(setcdr old value)
- (setcar (cdr node) (nconc (cadr node) (list (cons attribute value)))))))
+ (setcar (cdr node) (cons (cons attribute value) attributes)))))
(defun dom-remove-attribute (node attribute)
"Remove ATTRIBUTE from NODE."
@@ -80,7 +75,7 @@ A typical attribute is `href'."
(defun dom-text (node)
"Return all the text bits in the current node concatenated."
- (mapconcat 'identity (cl-remove-if-not 'stringp (dom-children node)) " "))
+ (mapconcat #'identity (cl-remove-if-not #'stringp (dom-children node)) " "))
(defun dom-texts (node &optional separator)
"Return all textual data under NODE concatenated with SEPARATOR in-between."
@@ -195,9 +190,7 @@ ATTRIBUTE would typically be `class', `id' or the like."
(defun dom-node (tag &optional attributes &rest children)
"Return a DOM node with TAG and ATTRIBUTES."
- (if children
- `(,tag ,attributes ,@children)
- (list tag attributes)))
+ `(,tag ,attributes ,@children))
(defun dom-append-child (node child)
"Append CHILD to the end of NODE's children."
@@ -215,11 +208,7 @@ If BEFORE is nil, make CHILD NODE's first child."
(let ((pos (if before
(cl-position before children)
0)))
- (if (zerop pos)
- ;; First child.
- (setcdr (cdr node) (cons child (cddr node)))
- (setcdr (nthcdr (1- pos) children)
- (cons child (nthcdr pos children))))))
+ (push child (nthcdr (+ 2 pos) node))))
node)
(defun dom-ensure-node (node)
@@ -247,7 +236,7 @@ white-space."
(insert (format "(%S . %S)" (car elem) (cdr elem)))
(if (zerop (cl-decf times))
(insert ")")
- (insert "\n" (make-string column ? ))))))
+ (insert "\n" (make-string column ?\s))))))
(let* ((children (if remove-empty
(cl-remove-if
(lambda (child)
@@ -258,16 +247,16 @@ white-space."
(times (length children)))
(if (null children)
(insert ")")
- (insert "\n" (make-string (1+ column) ? ))
+ (insert "\n" (make-string (1+ column) ?\s))
(dolist (child children)
(if (stringp child)
- (if (or (not remove-empty)
- (not (string-match "\\`[\n\r\t ]*\\'" child)))
+ (if (not (and remove-empty
+ (string-match "\\`[\n\r\t ]*\\'" child)))
(insert (format "%S" child)))
(dom-pp child remove-empty))
(if (zerop (cl-decf times))
(insert ")")
- (insert "\n" (make-string (1+ column) ? ))))))))
+ (insert "\n" (make-string (1+ column) ?\s))))))))
(defun dom-print (dom &optional pretty xml)
"Print DOM at point as HTML/XML.
@@ -279,18 +268,19 @@ If XML, generate XML instead of HTML."
(dolist (elem attr)
;; In HTML, these are boolean attributes that should not have
;; an = value.
- (if (and (memq (car elem)
- '(async autofocus autoplay checked
- contenteditable controls default
- defer disabled formNoValidate frameborder
- hidden ismap itemscope loop
- multiple muted nomodule novalidate open
- readonly required reversed
- scoped selected typemustmatch))
- (cdr elem)
- (not xml))
- (insert (format " %s" (car elem)))
- (insert (format " %s=%S" (car elem) (cdr elem))))))
+ (insert (if (and (memq (car elem)
+ '(async autofocus autoplay checked
+ contenteditable controls default
+ defer disabled formNoValidate frameborder
+ hidden ismap itemscope loop
+ multiple muted nomodule novalidate open
+ readonly required reversed
+ scoped selected typemustmatch))
+ (cdr elem)
+ (not xml))
+ (format " %s" (car elem))
+ (format " %s=\"%s\"" (car elem)
+ (url-insert-entities-in-string (cdr elem)))))))
(let* ((children (dom-children dom))
(non-text nil))
(if (null children)
@@ -301,7 +291,7 @@ If XML, generate XML instead of HTML."
(insert child)
(setq non-text t)
(when pretty
- (insert "\n" (make-string (+ column 2) ? )))
+ (insert "\n" (make-string (+ column 2) ?\s)))
(dom-print child pretty xml)))
;; If we inserted non-text child nodes, or a text node that
;; ends with a newline, then we indent the end tag.
@@ -310,7 +300,7 @@ If XML, generate XML instead of HTML."
non-text))
(unless (bolp)
(insert "\n"))
- (insert (make-string column ? )))
+ (insert (make-string column ?\s)))
(insert (format "</%s>" (dom-tag dom)))))))
(provide 'dom)
diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el
index 8ac9a1e9e6..ee6d1ceb35 100644
--- a/lisp/dynamic-setting.el
+++ b/lisp/dynamic-setting.el
@@ -51,19 +51,11 @@ the current form for the frame (i.e. hinting or somesuch
changed)."
;; Set the font on all current and future frames, as though
;; the `default' face had been "set for this session":
(set-frame-font new-font nil frame-list)
- ;; Just redraw the existing fonts on all frames:
- (dolist (f frame-list)
- (let ((frame-font
- (or (font-get (face-attribute 'default :font f 'default)
- :user-spec)
- (frame-parameter f 'font-parameter))))
- (when frame-font
- (set-frame-parameter f 'font-parameter frame-font)
- (set-face-attribute 'default f
- :width 'normal
- :weight 'normal
- :slant 'normal
- :font frame-font))))))))
+ ;; Just reconsider the existing fonts on all frames on each
+ ;; display, by clearing the font and face caches. This will
+ ;; cause all fonts to be recreated.
+ (dolist (frame frame-list)
+ (reconsider-frame-fonts frame))))))
(defun dynamic-setting-handle-config-changed-event (event)
"Handle config-changed-event on the display in EVENT.
diff --git a/lisp/ecomplete.el b/lisp/ecomplete.el
index 6ff67d46d2..b532ef95e7 100644
--- a/lisp/ecomplete.el
+++ b/lisp/ecomplete.el
@@ -70,9 +70,9 @@
:type '(symbol :tag "Coding system"))
(defcustom ecomplete-sort-predicate #'ecomplete-decay
- "Predicate to use when sorting matched.
-The predicate is called with two parameters that represent the
-completion. Each parameter is a list where the first element is
+ "Predicate to use when sorting matched ecomplete candidates.
+The predicate is called with two arguments that represent the
+completion. Each argument is a list where the first element is
the times the completion has been used, the second is the
timestamp of the most recent usage, and the third item is the
string that was matched."
@@ -86,6 +86,12 @@ string that was matched."
:type 'boolean
:version "29.1")
+(defcustom ecomplete-filter-regexp nil
+ "Regular expression of addresses that should not be stored by ecomplete."
+ :type '(choice (const :tag "None" nil)
+ (regexp :tag "Regexp"))
+ :version "29.1")
+
;;; Internal variables.
(defvar ecomplete-database nil)
@@ -104,20 +110,22 @@ string that was matched."
By default, the longest version of TEXT will be preserved, but if
FORCE is non-nil, use TEXT exactly as is."
(unless ecomplete-database (ecomplete-setup))
- (let ((elems (assq type ecomplete-database))
- (now (time-convert nil 'integer))
- entry)
- (unless elems
- (push (setq elems (list type)) ecomplete-database))
- (if (setq entry (assoc key (cdr elems)))
- (pcase-let ((`(,_key ,count ,_time ,oldtext) entry))
- (setcdr entry (list (1+ count) now
- ;; Preserve the "more complete" text.
- (if (or force
- (>= (length text) (length oldtext)))
- text
- oldtext))))
- (nconc elems (list (list key 1 now text))))))
+ (unless (and ecomplete-filter-regexp
+ (string-match-p ecomplete-filter-regexp key))
+ (let ((elems (assq type ecomplete-database))
+ (now (time-convert nil 'integer))
+ entry)
+ (unless elems
+ (push (setq elems (list type)) ecomplete-database))
+ (if (setq entry (assoc key (cdr elems)))
+ (pcase-let ((`(,_key ,count ,_time ,oldtext) entry))
+ (setcdr entry (list (1+ count) now
+ ;; Preserve the "more complete" text.
+ (if (or force
+ (>= (length text) (length oldtext)))
+ text
+ oldtext))))
+ (nconc elems (list (list key 1 now text)))))))
(defun ecomplete--remove-item (type key)
"Remove the element of TYPE and KEY from the ecomplete database."
@@ -182,7 +190,7 @@ FORCE is non-nil, use TEXT exactly as is."
If CHOOSE, allow the user to choose interactively between the
matches.
-Auto-select when `ecomplete-message-display-abbrev-auto-select' is
+Auto-select when `ecomplete-auto-select' is
non-nil and there is only a single completion option available."
(let* ((matches (ecomplete-get-matches type word))
(match-list (and matches (split-string matches "\n")))
@@ -289,7 +297,7 @@ non-nil and there is only a single completion option
available."
nil t)))
(defun ecomplete-edit ()
- "Prompt for an item and allow editing it."
+ "Prompt for an ecomplete item and allow editing it."
(interactive)
(let* ((type (ecomplete--prompt-type))
(data (cdr (assq type ecomplete-database)))
@@ -305,7 +313,8 @@ non-nil and there is only a single completion option
available."
(ecomplete-save)))
(defun ecomplete-remove ()
- "Remove entries matching a regexp from the ecomplete database."
+ "Remove from the ecomplete database the entries matching a regexp.
+Prompt for the regexp to match the database entries to be removed."
(interactive)
(let* ((type (ecomplete--prompt-type))
(data (cdr (assq type ecomplete-database)))
diff --git a/lisp/elide-head.el b/lisp/elide-head.el
index 90bf1fe35b..75a3612df9 100644
--- a/lisp/elide-head.el
+++ b/lisp/elide-head.el
@@ -53,8 +53,8 @@
`(;; GNU GPL
("is free software[:;] you can redistribute it" .
,(rx (or (seq "If not, see " (? "<")
- "http" (? "s") "://www.gnu.org/licenses/"
- (? ">") (? " "))
+ "http" (? "s") "://www.gnu.org/licenses"
+ (? "/") (? ">") (? " "))
(seq "Boston, MA " (? " ")
"0211" (or "1-1307" "0-1301")
(or " " ", ") "USA")
diff --git a/lisp/emacs-lisp/backtrace.el b/lisp/emacs-lisp/backtrace.el
index 4ffe6f573c..d461698c88 100644
--- a/lisp/emacs-lisp/backtrace.el
+++ b/lisp/emacs-lisp/backtrace.el
@@ -753,7 +753,7 @@ property for use by navigation."
(defun backtrace--line-length-or-nil ()
"Return `backtrace-line-length' if valid, nil else."
- ;; mirror the logic in `cl-print-to-string-with-limits'
+ ;; mirror the logic in `cl-print-to-string-with-limit'
(and (natnump backtrace-line-length)
(not (zerop backtrace-line-length))
backtrace-line-length))
diff --git a/lisp/emacs-lisp/benchmark.el b/lisp/emacs-lisp/benchmark.el
index 47bc3a4524..4bf61abe54 100644
--- a/lisp/emacs-lisp/benchmark.el
+++ b/lisp/emacs-lisp/benchmark.el
@@ -31,6 +31,7 @@
;;; Code:
+(require 'cl-lib)
(eval-when-compile (require 'subr-x)) ;For `named-let'.
(defmacro benchmark-elapse (&rest forms)
diff --git a/lisp/emacs-lisp/bindat.el b/lisp/emacs-lisp/bindat.el
index 0ecac3d52a..82d3c5309f 100644
--- a/lisp/emacs-lisp/bindat.el
+++ b/lisp/emacs-lisp/bindat.el
@@ -163,7 +163,9 @@
(let ((s (substring bindat-raw bindat-idx (+ bindat-idx len))))
(setq bindat-idx (+ bindat-idx len))
(if (stringp s) s
- (apply #'unibyte-string s))))
+ ;; FIXME: There should be a more efficient way to do this.
+ ;; Should `apply' accept vectors in addition to lists?
+ (apply #'unibyte-string (append s nil)))))
(defun bindat--unpack-strz (&optional len)
(let ((i 0) s)
@@ -172,7 +174,7 @@
(setq s (substring bindat-raw bindat-idx (+ bindat-idx i)))
(setq bindat-idx (+ bindat-idx (or len (1+ i))))
(if (stringp s) s
- (apply #'unibyte-string s))))
+ (apply #'unibyte-string (append s nil)))))
(defun bindat--unpack-bits (len)
(let ((bits nil) (bnum (1- (* 8 len))) j m)
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 5ef2d7fe82..a7e1df3622 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -178,7 +178,7 @@ Earlier variables shadow later ones with the same name.")
;; be displayed when the function's source file will be
;; compiled anyway, but more importantly we would otherwise
;; emit spurious warnings here because we don't have the full
- ;; context, such as `declare-functions' placed earlier in the
+ ;; context, such as `declare-function's placed earlier in the
;; source file's code or `with-suppressed-warnings' that
;; surrounded the `defsubst'.
(byte-compile-warnings nil))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 9db84c31b8..a33808ab92 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -481,6 +481,11 @@ convention was modified."
(puthash (indirect-function function) signature
advertised-signature-table))
+(defun get-advertised-calling-convention (function)
+ "Get the advertised SIGNATURE of FUNCTION.
+Return t if there isn't any."
+ (gethash function advertised-signature-table t))
+
(defun make-obsolete (obsolete-name current-name when)
"Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
OBSOLETE-NAME should be a function name or macro name (a symbol).
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 03c45e44a5..f176e769bf 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -129,6 +129,7 @@
;; us from emitting warnings when compiling files which use cl-lib without
;; requiring it! (bug#30635)
(eval-when-compile (require 'cl-lib))
+(eval-when-compile (require 'subr-x))
;; The feature of compiling in a specific target Emacs version
;; has been turned off because compile time options are a bad idea.
@@ -1185,27 +1186,22 @@ message buffer `default-directory'."
(defun byte-compile--first-symbol-with-pos (form)
"Return the first symbol with position in form, or nil if none.
Order is by depth-first search."
- (cond
- ((symbol-with-pos-p form) form)
- ((consp form)
- (or (byte-compile--first-symbol-with-pos (car form))
- (let ((sym nil))
- (setq form (cdr form))
- (while (and (consp form)
- (not (setq sym (byte-compile--first-symbol-with-pos
- (car form)))))
- (setq form (cdr form)))
- (or sym
- (and form (byte-compile--first-symbol-with-pos form))))))
- ((or (vectorp form) (recordp form))
- (let ((len (length form))
- (i 0)
- (sym nil))
- (while (and (< i len)
- (not (setq sym (byte-compile--first-symbol-with-pos
- (aref form i)))))
- (setq i (1+ i)))
- sym))))
+ (named-let loop ((form form)
+ (depth 10)) ;Arbitrary limit.
+ (cond
+ ((<= depth 0) nil) ;Avoid cycles (bug#58601).
+ ((symbol-with-pos-p form) form)
+ ((consp form)
+ (or (loop (car form) (1- depth))
+ (loop (cdr form) (1- depth))))
+ ((or (vectorp form) (recordp form))
+ (let ((len (length form))
+ (i 0)
+ (sym nil))
+ (while (and (< i len)
+ (not (setq sym (loop (aref form i) (1- depth)))))
+ (setq i (1+ i)))
+ sym)))))
(defun byte-compile--warning-source-offset ()
"Return a source offset from `byte-compile-form-stack' or nil if none."
@@ -1405,11 +1401,11 @@ when printing the error message."
(and (not macro-p)
(compiled-function-p (symbol-function fn)))))
(setq fn (symbol-function fn)))
- (let ((advertised (gethash (if (and (symbolp fn) (fboundp fn))
- ;; Could be a subr.
- (symbol-function fn)
- fn)
- advertised-signature-table t)))
+ (let ((advertised (get-advertised-calling-convention
+ (if (and (symbolp fn) (fboundp fn))
+ ;; Could be a subr.
+ (symbol-function fn)
+ fn))))
(cond
((listp advertised)
(if macro-p
@@ -1469,9 +1465,11 @@ when printing the error message."
(defun byte-compile-arglist-signature-string (signature)
(cond ((null (cdr signature))
- (format "%d+" (car signature)))
+ (format "%d or more" (car signature)))
((= (car signature) (cdr signature))
(format "%d" (car signature)))
+ ((= (1+ (car signature)) (cdr signature))
+ (format "%d or %d" (car signature) (cdr signature)))
(t (format "%d-%d" (car signature) (cdr signature)))))
(defun byte-compile-function-warn (f nargs def)
@@ -1884,6 +1882,9 @@ Files in subdirectories of DIRECTORY are processed also."
(interactive "DByte force recompile (directory): ")
(byte-recompile-directory directory nil t))
+(defvar byte-compile-ignore-files nil
+ "List of regexps for files to ignore during byte compilation.")
+
;;;###autoload
(defun byte-recompile-directory (directory &optional arg force follow-symlinks)
"Recompile every `.el' file in DIRECTORY that needs recompilation.
@@ -1940,14 +1941,22 @@ also be compiled."
;; This file is a subdirectory. Handle them differently.
(or (null arg) (eq 0 arg)
(y-or-n-p (concat "Check " source "? ")))
- (setq directories (nconc directories (list source))))
+ ;; Directory is requested to be ignored
+ (not (string-match-p
+ (regexp-opt byte-compile-ignore-files)
+ source))
+ (setq directories (nconc directories (list source))))
;; It is an ordinary file. Decide whether to compile it.
(if (and (string-match emacs-lisp-file-regexp source)
;; The next 2 tests avoid compiling lock files
(file-readable-p source)
(not (string-match "\\`\\.#" file))
(not (auto-save-file-name-p source))
- (not (member source (dir-locals--all-files
directory))))
+ (not (member source (dir-locals--all-files directory)))
+ ;; File is requested to be ignored
+ (not (string-match-p
+ (regexp-opt byte-compile-ignore-files)
+ source)))
(progn (cl-incf
(pcase (byte-recompile-file source force arg)
('no-byte-compile skip-count)
@@ -2321,9 +2330,15 @@ With argument ARG, insert value in current buffer after
the form."
(setq case-fold-search nil))
(displaying-byte-compile-warnings
(with-current-buffer inbuffer
- (and byte-compile-current-file
- (byte-compile-insert-header byte-compile-current-file
- byte-compile--outbuffer))
+ (when byte-compile-current-file
+ (byte-compile-insert-header byte-compile-current-file
+ byte-compile--outbuffer)
+ ;; Instruct native-comp to ignore this file.
+ (when (bound-and-true-p no-native-compile)
+ (with-current-buffer byte-compile--outbuffer
+ (insert
+ "(when (boundp 'comp--no-native-compile)
+ (puthash load-file-name t comp--no-native-compile))\n\n"))))
(goto-char (point-min))
;; Should we always do this? When calling multiple files, it
;; would be useful to delay this warning until all have been
@@ -2561,7 +2576,7 @@ list that represents a doc string reference.
;; macroexpand-all.
;; (if (memq byte-optimize '(t source))
;; (setq form (byte-optimize-form form for-effect)))
- (cconv-closure-convert form))
+ (cconv-closure-convert form byte-compile-bound-variables))
;; byte-hunk-handlers cannot call this!
(defun byte-compile-toplevel-file-form (top-level-form)
@@ -3622,7 +3637,7 @@ lambda-expression."
(byte-compile-out base-op tmp)))
(defun byte-compile-dynamic-variable-bind (var)
- "Generate code to bind the lexical variable VAR to the top-of-stack value."
+ "Generate code to bind the dynamic variable VAR to the top-of-stack value."
(byte-compile-check-variable var 'let-bind)
(push var byte-compile-bound-variables)
(byte-compile-dynamic-variable-op 'byte-varbind var))
@@ -4659,13 +4674,6 @@ Return the offset in the form (VAR . OFFSET)."
(byte-compile-form (cadr clause))
(byte-compile-push-constant nil)))))
-(defun byte-compile-not-lexical-var-p (var)
- (or (not (symbolp var))
- (special-variable-p var)
- (memq var byte-compile-bound-variables)
- (memq var '(nil t))
- (keywordp var)))
-
(defun byte-compile-bind (var init-lexenv)
"Emit byte-codes to bind VAR and update `byte-compile--lexical-environment'.
INIT-LEXENV should be a lexical-environment alist describing the
@@ -4674,7 +4682,7 @@ Return non-nil if the TOS value was popped."
;; The mix of lexical and dynamic bindings mean that we may have to
;; juggle things on the stack, to move them to TOS for
;; dynamic binding.
- (if (and lexical-binding (not (byte-compile-not-lexical-var-p var)))
+ (if (not (cconv--not-lexical-var-p var byte-compile-bound-variables))
;; VAR is a simple stack-allocated lexical variable.
(progn (push (assq var init-lexenv)
byte-compile--lexical-environment)
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 23d0f12194..f3431db415 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -64,20 +64,12 @@
;;
;;; Code:
-;; PROBLEM cases found during conversion to lexical binding.
-;; We should try and detect and warn about those cases, even
-;; for lexical-binding==nil to help prepare the migration.
-;; - Uses of run-hooks, and friends.
-;; - Cases where we want to apply the same code to different vars depending on
-;; some test. These sometimes use a (let ((foo (if bar 'a 'b)))
-;; ... (symbol-value foo) ... (set foo ...)).
-
;; TODO: (not just for cconv but also for the lexbind changes in general)
;; - let (e)debug find the value of lexical variables from the stack.
;; - make eval-region do the eval-sexp-add-defvars dance.
;; - byte-optimize-form should be applied before cconv.
;; OTOH, the warnings emitted by cconv-analyze need to come before optimize
-;; since afterwards they can because obnoxious (warnings about an "unused
+;; since afterwards they can become obnoxious (warnings about an "unused
;; variable" should not be emitted when the variable use has simply been
;; optimized away).
;; - let macros specify that some let-bindings come from the same source,
@@ -87,33 +79,9 @@
;; - canonize code in macro-expand so we don't have to handle (let (var) body)
;; and other oddities.
;; - new byte codes for unwind-protect so that closures aren't needed at all.
-;; - a reference to a var that is known statically to always hold a constant
-;; should be turned into a byte-constant rather than a byte-stack-ref.
-;; Hmm... right, that's called constant propagation and could be done here,
-;; but when that constant is a function, we have to be careful to make sure
-;; the bytecomp only compiles it once.
;; - Since we know here when a variable is not mutated, we could pass that
;; info to the byte-compiler, e.g. by using a new `immutable-let'.
;; - call known non-escaping functions with `goto' rather than `call'.
-;; - optimize mapc to a dolist loop.
-
-;; (defmacro dlet (binders &rest body)
-;; ;; Works in both lexical and non-lexical mode.
-;; (declare (indent 1) (debug let))
-;; `(progn
-;; ,@(mapcar (lambda (binder)
-;; `(defvar ,(if (consp binder) (car binder) binder)))
-;; binders)
-;; (let ,binders ,@body)))
-
-;; (defmacro llet (binders &rest body)
-;; ;; Only works in lexical-binding mode.
-;; `(funcall
-;; (lambda ,(mapcar (lambda (binder) (if (consp binder) (car binder)
binder))
-;; binders)
-;; ,@body)
-;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
-;; binders)))
(eval-when-compile (require 'cl-lib))
@@ -142,13 +110,19 @@ is less than this number.")
;; interactive forms.
(make-hash-table :test #'eq :weakness 'key))
+(defvar cconv--dynbound-variables nil
+ "List of variables known to be dynamically bound.")
+
;;;###autoload
-(defun cconv-closure-convert (form)
+(defun cconv-closure-convert (form &optional dynbound-vars)
"Main entry point for closure conversion.
FORM is a piece of Elisp code after macroexpansion.
+DYNBOUND-VARS is a list of symbols that should be considered as
+using dynamic scoping.
Returns a form where all lambdas don't have any free variables."
- (let ((cconv-freevars-alist '())
+ (let ((cconv--dynbound-variables dynbound-vars)
+ (cconv-freevars-alist '())
(cconv-var-classification '()))
;; Analyze form - fill these variables with new information.
(cconv-analyze-form form '())
@@ -156,8 +130,6 @@ Returns a form where all lambdas don't have any free
variables."
(prog1 (cconv-convert form nil nil) ; Env initially empty.
(cl-assert (null cconv-freevars-alist)))))
-(defconst cconv--dummy-var (make-symbol "ignored"))
-
(defun cconv--set-diff (s1 s2)
"Return elements of set S1 that are not in set S2."
(let ((res '()))
@@ -262,9 +234,7 @@ Returns a form where all lambdas don't have any free
variables."
;; it is often non-trivial for the programmer to avoid such
;; unused vars.
(not (intern-soft var))
- (eq ?_ (aref (symbol-name var) 0))
- ;; As a special exception, ignore "ignored".
- (eq var 'ignored))
+ (eq ?_ (aref (symbol-name var) 0)))
(let ((suggestions (help-uni-confusable-suggestions (symbol-name var))))
(format "Unused lexical %s `%S'%s"
varkind (bare-symbol var)
@@ -342,7 +312,7 @@ EXTEND is a list of variables which might need to be
accessed even from places
where they are shadowed, because some part of ENV causes them to be used at
places where they originally did not directly appear."
(cl-assert (not (delq nil (mapcar (lambda (mapping)
- (if (eq (cadr mapping) 'apply-partially)
+ (if (eq (cadr mapping) #'apply-partially)
(cconv--set-diff (cdr (cddr mapping))
extend)))
env))))
@@ -634,6 +604,12 @@ places where they originally did not directly appear."
(defvar byte-compile-lexical-variables)
+(defun cconv--not-lexical-var-p (var dynbounds)
+ (or (not lexical-binding)
+ (not (symbolp var))
+ (special-variable-p var)
+ (memq var dynbounds)))
+
(defun cconv--analyze-use (vardata form varkind)
"Analyze the use of a variable.
VARDATA should be (BINDER READ MUTATED CAPTURED CALLED).
@@ -677,7 +653,7 @@ FORM is the parent form that binds this var."
;; outside of it.
(envcopy
(mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env))
- (byte-compile-bound-variables byte-compile-bound-variables)
+ (cconv--dynbound-variables cconv--dynbound-variables)
(newenv envcopy))
;; Push it before recursing, so cconv-freevars-alist contains entries in
;; the order they'll be used by closure-convert-rec.
@@ -685,7 +661,7 @@ FORM is the parent form that binds this var."
(when lexical-binding
(dolist (arg args)
(cond
- ((byte-compile-not-lexical-var-p arg)
+ ((cconv--not-lexical-var-p arg cconv--dynbound-variables)
(byte-compile-warn-x
arg
"Lexical argument shadows the dynamic variable %S"
@@ -715,6 +691,8 @@ FORM is the parent form that binds this var."
(setf (nth 3 (car env)) t))
(setq env (cdr env) envcopy (cdr envcopy))))))
+(defvar cconv--dynbindings)
+
(defun cconv-analyze-form (form env)
"Find mutated variables and variables captured by closure.
Analyze lambdas if they are suitable for lambda lifting.
@@ -730,7 +708,7 @@ This function does not return anything but instead fills the
(let ((orig-env env)
(newvars nil)
(var nil)
- (byte-compile-bound-variables byte-compile-bound-variables)
+ (cconv--dynbound-variables cconv--dynbound-variables)
(value nil))
(dolist (binder binders)
(if (not (consp binder))
@@ -743,7 +721,9 @@ This function does not return anything but instead fills the
(cconv-analyze-form value (if (eq letsym 'let*) env orig-env)))
- (unless (or (byte-compile-not-lexical-var-p var) (not
lexical-binding))
+ (if (cconv--not-lexical-var-p var cconv--dynbound-variables)
+ (when (boundp 'cconv--dynbindings)
+ (push var cconv--dynbindings))
(cl-pushnew var byte-compile-lexical-variables)
(let ((varstruct (list var nil nil nil nil)))
(push (cons binder (cdr varstruct)) newvars)
@@ -797,7 +777,8 @@ This function does not return anything but instead fills the
(cconv-analyze-form protected-form env)
(unless lexical-binding
(setq var nil))
- (when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
+ (when (and var (symbolp var)
+ (cconv--not-lexical-var-p var cconv--dynbound-variables))
(byte-compile-warn-x
var "Lexical variable shadows the dynamic variable %S" var))
(let* ((varstruct (list var nil nil nil nil)))
@@ -813,9 +794,9 @@ This function does not return anything but instead fills the
(cconv-analyze-form form env)
(cconv--analyze-function () body env form))
- (`(defvar ,var) (push var byte-compile-bound-variables))
+ (`(defvar ,var) (push var cconv--dynbound-variables))
(`(,(or 'defconst 'defvar) ,var ,value . ,_)
- (push var byte-compile-bound-variables)
+ (push var cconv--dynbound-variables)
(cconv-analyze-form value env))
(`(,(or 'funcall 'apply) ,fun . ,args)
@@ -847,5 +828,78 @@ This function does not return anything but instead fills
the
(setf (nth 1 dv) t))))))
(define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form
"25.1")
+(defun cconv-fv (form lexvars dynvars)
+ "Return the list of free variables in FORM.
+LEXVARS is the list of statically scoped vars in the context
+and DYNVARS is the list of dynamically scoped vars in the context.
+Returns a pair (LEXV . DYNV) of those vars actually used by FORM."
+ (let* ((fun
+ ;; Wrap FORM into a function because the analysis code we
+ ;; have only computes freevars for functions.
+ ;; In practice FORM is always already of the form
+ ;; #'(lambda ...), so optimize for this case.
+ (if (and (eq 'function (car-safe form))
+ (eq 'lambda (car-safe (cadr form)))
+ ;; To get correct results, FUN needs to be a "simple lambda"
+ ;; without nested forms that aren't part of the body. :-(
+ (not (assq 'interactive (cadr form)))
+ (not (assq ':documentation (cadr form))))
+ form
+ `#'(lambda () ,form)))
+ (analysis-env (mapcar (lambda (v) (list v nil nil nil nil)) lexvars))
+ (cconv--dynbound-variables dynvars)
+ (byte-compile-lexical-variables nil)
+ (cconv--dynbindings nil)
+ (cconv-freevars-alist '())
+ (cconv-var-classification '()))
+ (let* ((body (cddr (cadr fun))))
+ ;; Analyze form - fill these variables with new information.
+ (cconv-analyze-form fun analysis-env)
+ (setq cconv-freevars-alist (nreverse cconv-freevars-alist))
+ (unless (equal (if (eq :documentation (car-safe (car body)))
+ (cdr body) body)
+ (caar cconv-freevars-alist))
+ (message "BOOH!\n%S\n%S"
+ body (caar cconv-freevars-alist)))
+ (cl-assert (equal (if (eq :documentation (car-safe (car body)))
+ (cdr body) body)
+ (caar cconv-freevars-alist)))
+ (let ((fvs (nreverse (cdar cconv-freevars-alist)))
+ (dyns (delq nil (mapcar (lambda (var) (car (memq var dynvars)))
+ (delete-dups cconv--dynbindings)))))
+ (cons fvs dyns)))))
+
+(defun cconv-make-interpreted-closure (fun env)
+ (cl-assert (eq (car-safe fun) 'lambda))
+ (let ((lexvars (delq nil (mapcar #'car-safe env))))
+ (if (null lexvars)
+ ;; The lexical environment is empty, so there's no need to
+ ;; look for free variables.
+ `(closure ,env . ,(cdr fun))
+ ;; We could try and cache the result of the macroexpansion and
+ ;; `cconv-fv' analysis. Not sure it's worth the trouble.
+ (let* ((form `#',fun)
+ (expanded-form
+ (let ((lexical-binding t) ;; Tell macros which dialect is in use.
+ ;; Make the macro aware of any defvar declarations in scope.
+ (macroexp--dynvars
+ (if macroexp--dynvars
+ (append env macroexp--dynvars) env)))
+ (macroexpand-all form macroexpand-all-environment)))
+ ;; Since we macroexpanded the body, we may as well use that.
+ (expanded-fun-cdr
+ (pcase expanded-form
+ (`#'(lambda . ,cdr) cdr)
+ (_ (cdr fun))))
+
+ (dynvars (delq nil (mapcar (lambda (b) (if (symbolp b) b)) env)))
+ (fvs (cconv-fv expanded-form lexvars dynvars))
+ (newenv (nconc (mapcar (lambda (fv) (assq fv env)) (car fvs))
+ (cdr fvs))))
+ ;; Never return a nil env, since nil means to use the dynbind
+ ;; dialect of ELisp.
+ `(closure ,(or newenv '(t)) . ,expanded-fun-cdr)))))
+
+
(provide 'cconv)
;;; cconv.el ends here
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 3f9bc28e0b..3bddb93b64 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -2265,8 +2265,8 @@ buffer, otherwise stop after the first error."
(unless (and sym (or (boundp sym) (fboundp sym)))
;; Find out how we spell-check this word.
(unless (or
- ;; All caps w/ option th, or s tacked on the end
- ;; for pluralization or number.
+ ;; All caps with option th, or s tacked on the
+ ;; end for pluralization or number.
(string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word)
(looking-at "}") ; a keymap expression
)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 7c7f027d77..66b214554e 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -615,12 +615,12 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
,(funcall setter
`(cl--set-getf ,getter ,k ,val))
,val)))))))))
- (let ((val-tail (cdr-safe (plist-member plist tag))))
+ (let ((val-tail (cdr (plist-member plist tag))))
(if val-tail (car val-tail) def)))
;;;###autoload
(defun cl--set-getf (plist tag val)
- (let ((val-tail (cdr-safe (plist-member plist tag))))
+ (let ((val-tail (cdr (plist-member plist tag))))
(if val-tail (progn (setcar val-tail val) plist)
(cl-list* tag val plist))))
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index b3ade3b894..7b6d43e572 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -650,13 +650,17 @@ The set of acceptable TYPEs (also called
\"specializers\") is defined
(cl--generic-name generic)
qualifiers specializers))
current-load-list :test #'equal)
- (let (;; Prevent `defalias' from recording this as the definition site of
+ (let ((old-adv-cc (get-advertised-calling-convention
+ (symbol-function sym)))
+ ;; Prevent `defalias' from recording this as the definition site of
;; the generic function.
current-load-list
;; BEWARE! Don't purify this function definition, since that leads
;; to memory corruption if the hash-tables it holds are modified
;; (the GC doesn't trace those pointers).
(purify-flag nil))
+ (when (listp old-adv-cc)
+ (set-advertised-calling-convention gfun old-adv-cc nil))
;; But do use `defalias', so that it interacts properly with nadvice,
;; e.g. for tracing/debug-on-entry.
(defalias sym gfun)))))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index beafee1d63..43a2ed9205 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -656,6 +656,8 @@ its argument list allows full Common Lisp conventions."
(check `(while ,var
(cond
((memq (car ,var) ',(append keys allow))
+ (unless (cdr ,var)
+ (error "Missing argument for %s" (car ,var)))
(setq ,var (cdr (cdr ,var))))
((car (cdr (memq (quote ,@allow) ,restarg)))
(setq ,var nil))
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 8cff06a383..1338ae6e13 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -96,7 +96,7 @@ Integer values are handled in the `range' slot.")
`comp-common-supertype'.")
(subtype-p-mem (make-hash-table :test #'equal) :type hash-table
:documentation "Serve memoization for
-`comp-subtype-p-mem'.")
+`comp-cstr-ctxt-subtype-p-mem'.")
(union-1-mem-no-range (make-hash-table :test #'equal) :type hash-table
:documentation "Serve memoization for
`comp-cstr-union-1'.")
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 6656b7e57c..0ee094c34d 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -57,7 +57,7 @@
:safe #'integerp
:version "28.1")
-(defcustom native-comp-debug (if (eq 'windows-nt system-type) 1 0)
+(defcustom native-comp-debug 0
"Debug level for native compilation, a number between 0 and 3.
This is intended for debugging the compiler itself.
0 no debug output.
@@ -67,7 +67,7 @@ This is intended for debugging the compiler itself.
passes and libgccjit log file."
:type 'natnum
:safe #'natnump
- :version "28.1")
+ :version "29.1")
(defcustom native-comp-verbose 0
"Compiler verbosity for native compilation, a number between 0 and 3.
@@ -687,6 +687,9 @@ Useful to hook into pass checkers.")
'native-compiler-error)
+(defvar comp-no-spawn nil
+ "Non-nil don't spawn native compilation processes.")
+
;; Moved early to avoid circularity when comp.el is loaded and
;; `macroexpand' needs to be advised (bug#47049).
;;;###autoload
@@ -696,12 +699,9 @@ Useful to hook into pass checkers.")
(memq subr-name native-comp-never-optimize-functions)
(gethash subr-name comp-installed-trampolines-h))
(cl-assert (subr-primitive-p (symbol-function subr-name)))
- (comp--install-trampoline
- subr-name
- (or (comp-trampoline-search subr-name)
- (comp-trampoline-compile subr-name)
- ;; Should never happen.
- (cl-assert nil)))))
+ (when-let ((trampoline (or (comp-trampoline-search subr-name)
+ (comp-trampoline-compile subr-name))))
+ (comp--install-trampoline subr-name trampoline))))
(cl-defstruct (comp-vec (:copier nil))
@@ -2057,9 +2057,10 @@ and the annotation emission."
"Lexically-scoped FUNCTION."
(let ((args (comp-func-l-args function)))
(cons (make-comp-mvar :constant (comp-args-base-min args))
- (make-comp-mvar :constant (if (comp-args-p args)
- (comp-args-max args)
- 'many)))))
+ (make-comp-mvar :constant (cond
+ ((comp-args-p args) (comp-args-max args))
+ ((comp-nargs-rest args) 'many)
+ (t (comp-nargs-nonrest args)))))))
(cl-defmethod comp-prepare-args-for-top-level ((function comp-func-d))
"Dynamically scoped FUNCTION."
@@ -2822,7 +2823,7 @@ blocks."
(first-processed (l)
(if-let ((p (cl-find-if (lambda (p) (comp-block-idom p)) l)))
p
- (signal 'native-ice "cant't find first preprocessed"))))
+ (signal 'native-ice "can't find first preprocessed"))))
(when-let ((blocks (comp-func-blocks comp-func))
(entry (gethash 'entry blocks))
@@ -3715,7 +3716,8 @@ Prepare every function for final compilation and drive
the C back-end."
(if (zerop
(call-process (expand-file-name invocation-name
invocation-directory)
- nil t t "--batch" "-l" temp-file))
+ nil t t "-no-comp-spawn" "--batch" "-l"
+ temp-file))
(progn
(delete-file temp-file)
output)
@@ -3927,6 +3929,7 @@ processes from `comp-async-compilations'"
"Start compiling files from `comp-files-queue' asynchronously.
When compilation is finished, run `native-comp-async-all-done-hook' and
display a message."
+ (cl-assert (null comp-no-spawn))
(if (or comp-files-queue
(> (comp-async-runnings) 0))
(unless (>= (comp-async-runnings) (comp-effective-async-max-jobs))
@@ -3945,8 +3948,8 @@ display a message."
(file-newer-than-file-p
source-file (comp-el-to-eln-filename source-file))))
do (let* ((expr `((require 'comp)
- (setq comp-async-compilation t)
- (setq warning-fill-column most-positive-fixnum)
+ (setq comp-async-compilation t
+ warning-fill-column most-positive-fixnum)
,(let ((set (list 'setq)))
(dolist (var '(comp-file-preloaded-p
native-compile-target-directory
@@ -4002,7 +4005,8 @@ display a message."
:command (list
(expand-file-name invocation-name
invocation-directory)
- "--batch" "-l" temp-file)
+ "-no-comp-spawn" "--batch" "-l"
+ temp-file)
:sentinel
(lambda (process _event)
(run-hook-with-args
@@ -4046,72 +4050,73 @@ the deferred compilation mechanism."
(stringp function-or-file))
(signal 'native-compiler-error
(list "Not a function symbol or file" function-or-file)))
- (catch 'no-native-compile
- (let* ((print-symbols-bare t)
- (data function-or-file)
- (comp-native-compiling t)
- (byte-native-qualities nil)
- (symbols-with-pos-enabled t)
- ;; Have byte compiler signal an error when compilation fails.
- (byte-compile-debug t)
- (comp-ctxt (make-comp-ctxt :output output
- :with-late-load with-late-load)))
- (comp-log "\n \n" 1)
- (unwind-protect
- (progn
- (condition-case err
- (cl-loop
- with report = nil
- for t0 = (current-time)
- for pass in comp-passes
- unless (memq pass comp-disabled-passes)
- do
- (comp-log (format "(%s) Running pass %s:\n"
- function-or-file pass)
- 2)
- (setf data (funcall pass data))
- (push (cons pass (float-time (time-since t0))) report)
- (cl-loop for f in (alist-get pass comp-post-pass-hooks)
- do (funcall f data))
- finally
- (when comp-log-time-report
- (comp-log (format "Done compiling %s" data) 0)
- (cl-loop for (pass . time) in (reverse report)
- do (comp-log (format "Pass %s took: %fs."
- pass time) 0))))
- (native-compiler-skip)
- (t
- (let ((err-val (cdr err)))
- ;; If we are doing an async native compilation print the
- ;; error in the correct format so is parsable and abort.
- (if (and comp-async-compilation
- (not (eq (car err) 'native-compiler-error)))
- (progn
- (message (if err-val
- "%s: Error: %s %s"
- "%s: Error %s")
- function-or-file
- (get (car err) 'error-message)
- (car-safe err-val))
- (kill-emacs -1))
- ;; Otherwise re-signal it adding the compilation input.
- (signal (car err) (if (consp err-val)
- (cons function-or-file err-val)
- (list function-or-file err-val)))))))
- (if (stringp function-or-file)
- data
- ;; So we return the compiled function.
- (native-elisp-load data)))
- ;; We may have created a temporary file when we're being
- ;; called with something other than a file as the argument.
- ;; Delete it.
- (when (and (not (stringp function-or-file))
- (not output)
- comp-ctxt
- (comp-ctxt-output comp-ctxt)
- (file-exists-p (comp-ctxt-output comp-ctxt)))
- (message "Deleting %s" (comp-ctxt-output comp-ctxt))
- (delete-file (comp-ctxt-output comp-ctxt)))))))
+ (when (or (null comp-no-spawn) comp-async-compilation)
+ (catch 'no-native-compile
+ (let* ((print-symbols-bare t)
+ (data function-or-file)
+ (comp-native-compiling t)
+ (byte-native-qualities nil)
+ (symbols-with-pos-enabled t)
+ ;; Have byte compiler signal an error when compilation fails.
+ (byte-compile-debug t)
+ (comp-ctxt (make-comp-ctxt :output output
+ :with-late-load with-late-load)))
+ (comp-log "\n \n" 1)
+ (unwind-protect
+ (progn
+ (condition-case err
+ (cl-loop
+ with report = nil
+ for t0 = (current-time)
+ for pass in comp-passes
+ unless (memq pass comp-disabled-passes)
+ do
+ (comp-log (format "(%s) Running pass %s:\n"
+ function-or-file pass)
+ 2)
+ (setf data (funcall pass data))
+ (push (cons pass (float-time (time-since t0))) report)
+ (cl-loop for f in (alist-get pass comp-post-pass-hooks)
+ do (funcall f data))
+ finally
+ (when comp-log-time-report
+ (comp-log (format "Done compiling %s" data) 0)
+ (cl-loop for (pass . time) in (reverse report)
+ do (comp-log (format "Pass %s took: %fs."
+ pass time) 0))))
+ (native-compiler-skip)
+ (t
+ (let ((err-val (cdr err)))
+ ;; If we are doing an async native compilation print the
+ ;; error in the correct format so is parsable and abort.
+ (if (and comp-async-compilation
+ (not (eq (car err) 'native-compiler-error)))
+ (progn
+ (message (if err-val
+ "%s: Error: %s %s"
+ "%s: Error %s")
+ function-or-file
+ (get (car err) 'error-message)
+ (car-safe err-val))
+ (kill-emacs -1))
+ ;; Otherwise re-signal it adding the compilation input.
+ (signal (car err) (if (consp err-val)
+ (cons function-or-file err-val)
+ (list function-or-file err-val)))))))
+ (if (stringp function-or-file)
+ data
+ ;; So we return the compiled function.
+ (native-elisp-load data)))
+ ;; We may have created a temporary file when we're being
+ ;; called with something other than a file as the argument.
+ ;; Delete it.
+ (when (and (not (stringp function-or-file))
+ (not output)
+ comp-ctxt
+ (comp-ctxt-output comp-ctxt)
+ (file-exists-p (comp-ctxt-output comp-ctxt)))
+ (message "Deleting %s" (comp-ctxt-output comp-ctxt))
+ (delete-file (comp-ctxt-output comp-ctxt))))))))
(defun native-compile-async-skip-p (file load selector)
"Return non-nil if FILE's compilation should be skipped.
@@ -4119,6 +4124,7 @@ the deferred compilation mechanism."
LOAD and SELECTOR work as described in `native--compile-async'."
;; Make sure we are not already compiling `file' (bug#40838).
(or (gethash file comp-async-compilations)
+ (gethash (file-name-with-extension file "elc") comp--no-native-compile)
(cond
((null selector) nil)
((functionp selector) (not (funcall selector file)))
@@ -4166,7 +4172,8 @@ bytecode definition was not changed in the meantime)."
(error "LOAD must be nil, t or 'late"))
(unless (listp files)
(setf files (list files)))
- (let (file-list)
+ (let ((added-something nil)
+ file-list)
(dolist (file-or-dir files)
(cond ((file-directory-p file-or-dir)
(dolist (file (if recursively
@@ -4194,16 +4201,31 @@ bytecode definition was not changed in the meantime)."
(make-directory out-dir t))
(if (file-writable-p out-filename)
(setf comp-files-queue
- (append comp-files-queue `((,file . ,load))))
+ (append comp-files-queue `((,file . ,load)))
+ added-something t)
(display-warning 'comp
(format "No write access for %s skipping."
out-filename)))))))
- (when (zerop (comp-async-runnings))
+ ;; Perhaps nothing passed `native-compile-async-skip-p'?
+ (when (and added-something
+ ;; Don't start if there's one already running.
+ (zerop (comp-async-runnings)))
(comp-run-async-workers))))
;;; Compiler entry points.
+(defun comp-compile-all-trampolines ()
+ "Pre-compile AOT all trampolines."
+ (let ((comp-running-batch-compilation t)
+ ;; We want to target only the 'native-lisp' directory.
+ (native-compile-target-directory
+ (car (last native-comp-eln-load-path))))
+ (mapatoms (lambda (f)
+ (when (subr-primitive-p (symbol-function f))
+ (message "Compiling trampoline for: %s" f)
+ (comp-trampoline-compile f))))))
+
;;;###autoload
(defun comp-lookup-eln (filename)
"Given a Lisp source FILENAME return the corresponding .eln file if found.
@@ -4223,14 +4245,13 @@ Search happens in `native-comp-eln-load-path'."
(defun native-compile (function-or-file &optional output)
"Compile FUNCTION-OR-FILE into native code.
This is the synchronous entry-point for the Emacs Lisp native
-compiler.
-FUNCTION-OR-FILE is a function symbol, a form, or the filename of
-an Emacs Lisp source file.
-If OUTPUT is non-nil, use it as the filename for the compiled
-object.
-If FUNCTION-OR-FILE is a filename, return the filename of the
-compiled object. If FUNCTION-OR-FILE is a function symbol or a
-form, return the compiled function."
+compiler. FUNCTION-OR-FILE is a function symbol, a form, or the
+filename of an Emacs Lisp source file. If OUTPUT is non-nil, use
+it as the filename for the compiled object. If FUNCTION-OR-FILE
+is a filename, if the compilation was successful return the
+filename of the compiled object. If FUNCTION-OR-FILE is a
+function symbol or a form, if the compilation was successful
+return the compiled function."
(comp--native-compile function-or-file nil output))
;;;###autoload
@@ -4317,13 +4338,15 @@ of (commands) to run simultaneously."
;; `invocation-directory'.
(setq dir (expand-file-name dir invocation-directory))
(when (file-exists-p dir)
- (dolist (subdir (directory-files dir t))
+ (dolist (subdir (seq-filter
+ (lambda (f) (not (string-match (rx "/." (? ".") eos)
f)))
+ (directory-files dir t)))
(when (and (file-directory-p subdir)
(file-writable-p subdir)
(not (equal (file-name-nondirectory
(directory-file-name subdir))
comp-native-version-dir)))
- (message "Deleting %s..." subdir)
+ (message "Deleting `%s'..." subdir)
;; We're being overly cautious here -- there shouldn't be
;; anything but .eln files in these directories.
(dolist (eln (directory-files subdir t "\\.eln\\(\\.tmp\\)?\\'"))
@@ -4335,6 +4358,6 @@ of (commands) to run simultaneously."
(provide 'comp)
-;; LocalWords: limplified limplified limplification limplify Limple LIMPLE
libgccjit elc eln
+;; LocalWords: limplified limplification limplify Limple LIMPLE libgccjit elc
eln
;;; comp.el ends here
diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el
index 6d4b29b552..8e61797315 100644
--- a/lisp/emacs-lisp/crm.el
+++ b/lisp/emacs-lisp/crm.el
@@ -201,7 +201,7 @@ This function is modeled after
`minibuffer-complete-and-exit'."
(if doexit (exit-minibuffer))))
(defun crm--choose-completion-string (choice buffer base-position
- &rest ignored)
+ &rest _ignored)
"Completion string chooser for `completing-read-multiple'.
This is called from `choose-completion-string-functions'.
It replaces the string that is currently being completed, without
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
index 6fd89a690d..e1801c45b7 100644
--- a/lisp/emacs-lisp/eldoc.el
+++ b/lisp/emacs-lisp/eldoc.el
@@ -55,21 +55,24 @@
:group 'extensions)
(defcustom eldoc-idle-delay 0.50
- "Number of seconds of idle time to wait before printing.
+ "Number of seconds of idle time to wait before displaying documentation.
If user input arrives before this interval of time has elapsed after the
-last input, no documentation will be printed.
+last input event, no documentation will be displayed.
-If this variable is set to 0, no idle time is required."
+If this variable is set to 0, display the documentation without any delay."
:type 'number)
(defcustom eldoc-print-after-edit nil
- "If non-nil, eldoc info is only shown when editing.
+ "If non-nil, eldoc info is only shown after editing commands.
Changing the value requires toggling `eldoc-mode'."
:type 'boolean)
(defcustom eldoc-echo-area-display-truncation-message t
"If non-nil, provide verbose help when a message has been truncated.
-If nil, truncated messages will just have \"...\" appended."
+When this is non-nil, and the documentation string was truncated to
+fit in the echo-area, the documentation will be followed by an
+explanation of how to display the full documentation text.
+If nil, truncated messages will just have \"...\" to indicate truncation."
:type 'boolean
:version "28.1")
@@ -93,22 +96,24 @@ Note that this variable has no effect, unless
(defcustom eldoc-echo-area-use-multiline-p 'truncate-sym-name-if-fit
"Allow long ElDoc doc strings to resize echo area display.
-If value is t, never attempt to truncate messages, even if the
-echo area must be resized to fit.
+If the value is t, never attempt to truncate messages, even if the
+echo area must be resized to fit. In that case, Emacs will resize
+the mini-window up to the limit set by `max-mini-window-height'.
If the value is a positive number, it is used to calculate a
-number of logical lines of documentation that ElDoc is allowed to
-put in the echo area. If a positive integer, the number is used
-directly, while a float specifies the number of lines as a
-proportion of the echo area frame's height.
+number of screen lines of documentation that ElDoc is allowed to
+put in the echo area. A positive integer specifies the maximum
+number of lines directly, while a floating-point number specifies
+the number of screen lines as a fraction of the echo area frame's
+height.
-If value is the symbol `truncate-sym-name-if-fit', the part of
+If the value is the symbol `truncate-sym-name-if-fit', the part of
the doc string that represents a symbol's name may be truncated
if it will enable the rest of the doc string to fit on a single
line, without resizing the echo area.
-If value is nil, a doc string is always truncated to fit in a
-single line of display in the echo area.
+If the value is nil, a doc string is always truncated to fit in a
+single screen line of echo-area display.
Any resizing of the echo area additionally respects
`max-mini-window-height'."
@@ -121,12 +126,12 @@ Any resizing of the echo area additionally respects
line" truncate-sym-name-if-fit)))
(defcustom eldoc-echo-area-prefer-doc-buffer nil
- "Prefer ElDoc's documentation buffer if it is showing in some frame.
+ "Prefer ElDoc's documentation buffer if it is displayed in some window.
If this variable's value is t, ElDoc will skip showing
documentation in the echo area if the dedicated documentation
-buffer (given by `eldoc-doc-buffer') is being displayed in some
-window. If the value is the symbol `maybe', then the echo area
-is only skipped if the documentation doesn't fit there."
+buffer (displayed by `eldoc-doc-buffer') is already displayed in
+some window. If the value is the symbol `maybe', then the echo area
+is only skipped if the documentation needs to be truncated there."
:type 'boolean)
(defface eldoc-highlight-function-argument
@@ -287,8 +292,10 @@ reflect the change."
(put 'eldoc-mode-line-string 'risky-local-variable t)
(defun eldoc-minibuffer-message (format-string &rest args)
- "Display messages in the mode-line when in the minibuffer.
-Otherwise work like `message'."
+ "Display message specified by FORMAT-STRING and ARGS on the mode-line as
needed.
+This function displays the message produced by formatting ARGS
+with FORMAT-STRING on the mode line when the current buffer is a minibuffer.
+Otherwise, it displays the message like `message' would."
(if (minibufferp)
(progn
(add-hook 'minibuffer-exit-hook
@@ -632,8 +639,8 @@ If INTERACTIVE is t, also display the buffer."
(when interactive (eldoc-doc-buffer t)))
(defun eldoc-documentation-default ()
- "Show first doc string for item at point.
-Default value for `eldoc-documentation-strategy'."
+ "Show the first non-nil documentation string for item at point.
+This is the default value for `eldoc-documentation-strategy'."
(run-hook-with-args-until-success 'eldoc-documentation-functions
(eldoc--make-callback :patient)))
@@ -651,18 +658,18 @@ else wait for all doc strings."
t)
(defun eldoc-documentation-compose ()
- "Show multiple doc strings at once after waiting for all.
-Meant as a value for `eldoc-documentation-strategy'."
+ "Show multiple documentation strings together after waiting for all of them.
+This is meant to be used as a value for `eldoc-documentation-strategy'."
(eldoc--documentation-compose-1 nil))
(defun eldoc-documentation-compose-eagerly ()
- "Show multiple doc strings at once as soon as possible.
-Meant as a value for `eldoc-documentation-strategy'."
+ "Show multiple documentation strings one by one as soon as possible.
+This is meant to be used as a value for `eldoc-documentation-strategy'."
(eldoc--documentation-compose-1 t))
(defun eldoc-documentation-enthusiast ()
- "Show most important doc string produced so far.
-Meant as a value for `eldoc-documentation-strategy'."
+ "Show most important documentation string produced so far.
+This is meant to be used as a value for `eldoc-documentation-strategy'."
(run-hook-wrapped 'eldoc-documentation-functions
(lambda (f)
(let* ((callback (eldoc--make-callback :enthusiast))
@@ -692,40 +699,42 @@ Meant as a value for `eldoc-documentation-strategy'."
(eldoc--documentation-strategy-defcustom eldoc-documentation-strategy
eldoc-documentation-function
#'eldoc-documentation-default
- "How to collect and organize results of `eldoc-documentation-functions'.
-
-This variable controls how `eldoc-documentation-functions', which
-specifies the sources of documentation, is queried and how its
-results are organized before being displayed to the user. The
-following values are allowed:
-
-- `eldoc-documentation-default': calls functions in the special
- hook in order until one is found that produces a doc string
- value. Display only that value;
-
-- `eldoc-documentation-compose': calls all functions in the
- special hook and displays all of the resulting doc strings
- together. Wait for all strings to be ready, and preserve their
- relative order as specified by the order of functions in the hook;
-
-- `eldoc-documentation-compose-eagerly': calls all functions in
- the special hook and displays as many of the resulting doc
- strings as possible, as soon as possible. Preserves the
- relative order of doc strings;
-
-- `eldoc-documentation-enthusiast': calls all functions in the
- special hook and displays only the most important resulting
- docstring one at any given time. A function appearing first in
- the special hook is considered more important.
-
-This variable can also be set to a function of no args that
-returns something other than a string or nil and allows for some
+ "How to collect and display results of `eldoc-documentation-functions'.
+
+This variable controls how to call the functions in the special hook
+`eldoc-documentation-functions', and how to organize their results
+for display to the user. The functions in `eldoc-documentation-functions'
+are the source of documentation, and act as back-end for ElDoc.
+
+The following values are supported:
+
+- `eldoc-documentation-default': Call functions in the special
+ hook in order, until one of them returns a non-nil string
+ value. Display only that string.
+
+- `eldoc-documentation-compose': Call all the functions in the
+ special hook and display all of the resulting strings together,
+ after all of the functions were called, and in the order of the
+ functions in the hook.
+
+- `eldoc-documentation-compose-eagerly': Call all the functions in
+ the special hook, and display each non-nil string as soon as it
+ is returned by a function, before calling the next function.
+
+- `eldoc-documentation-enthusiast': Call all the functions in the
+ special hook, and display only the most important resulting
+ string at any given time. A function appearing first in
+ the special hook is considered more important than those which
+ appear after it.
+
+This variable can also be set to a function of no arguments that
+returns something other than a string or nil, and allows for some
or all of the special hook `eldoc-documentation-functions' to be
run. In that case, the strategy function should follow that
-other variable's protocol closely and endeavor to display the
-resulting doc strings itself.
+other variable's protocol closely and display the resulting doc
+strings itself.
-For backward compatibility to the \"old\" protocol, this variable
+For backward compatibility with the \"old\" protocol, this variable
can also be set to a function that returns nil or a doc string,
depending whether or not there is documentation to display at
all."
diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el
index a891f068a7..49f2a1d696 100644
--- a/lisp/emacs-lisp/ert-x.el
+++ b/lisp/emacs-lisp/ert-x.el
@@ -560,6 +560,7 @@ The same keyword arguments are supported as in
'("mock"
(tramp-login-program "sh")
(tramp-login-args (("-i")))
+ (tramp-direct-async ("-c"))
(tramp-remote-shell "/bin/sh")
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el
index 047b0069bb..c25ade22d6 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -208,7 +208,7 @@ is run. If a macro (possibly with side effects) is to be
tested,
it has to be wrapped in `(eval (quote ...))'.
If NAME is already defined as a test and Emacs is running
-in batch mode, an error is signalled.
+in batch mode, an error is signaled.
\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \
[:tags \\='(TAG...)] BODY...)"
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index a96fa19a3f..11251d7a96 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -445,16 +445,17 @@ The return value is the last VAL in the list.
,v))))))))))
(gv-define-expander plist-get
- (lambda (do plist prop)
+ (lambda (do plist prop &optional predicate)
(macroexp-let2 macroexp-copyable-p key prop
(gv-letplace (getter setter) plist
- (macroexp-let2 nil p `(cdr (plist-member ,getter ,key))
+ (macroexp-let2 nil p `(cdr (plist-member ,getter ,key ,predicate))
(funcall do
`(car ,p)
(lambda (val)
`(if ,p
(setcar ,p ,val)
- ,(funcall setter `(cons ,key (cons ,val
,getter)))))))))))
+ ,(funcall setter
+ `(cons ,key (cons ,val ,getter)))))))))))
;;; Some occasionally handy extensions.
diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el
index 6c95d86b47..d955019a9d 100644
--- a/lisp/emacs-lisp/hierarchy.el
+++ b/lisp/emacs-lisp/hierarchy.el
@@ -71,7 +71,8 @@
(:conc-name hierarchy--))
(roots (list)) ; list of the hierarchy roots (no parent)
(parents (make-hash-table :test 'equal)) ; map an item to its parent
- (children (make-hash-table :test 'equal)) ; map an item to its childre
+ (children (make-hash-table :test 'equal)) ; map an item to its children
+ (delaying-parents (make-hash-table :test 'equal)) ; map an item to its
childrenfn
;; cache containing the set of all items in the hierarchy
(seen-items (make-hash-table :test 'equal))) ; map an item to t
@@ -133,7 +134,8 @@ keys are :key and :test."
"Create a hierarchy and return it."
(hierarchy--make))
-(defun hierarchy-add-tree (hierarchy item parentfn &optional childrenfn
acceptfn)
+(defun hierarchy-add-tree (hierarchy item parentfn
+ &optional childrenfn acceptfn
delay-children-p)
"In HIERARCHY, add ITEM.
PARENTFN is either nil or a function defining the child-to-parent
@@ -151,33 +153,45 @@ CHILDRENFN are expected to be coherent with each other.
ACCEPTFN is a function returning non-nil if its parameter (any object)
should be an item of the hierarchy. By default, ACCEPTFN returns non-nil
-if its parameter is non-nil."
+if its parameter is non-nil.
+
+DELAY-CHILDREN-P is a predicate determining whether the children that would
+normally be processed by CHILDRENFN should, instead, have their processing be
+delayed and stored to be processed by CHILDRENFN when the child is selected
+during use of the hierarchy."
(unless (hierarchy-has-item hierarchy item)
(let ((acceptfn (or acceptfn #'identity)))
(hierarchy--seen-items-add hierarchy item)
(let ((parent (and parentfn (funcall parentfn item))))
(when (funcall acceptfn parent)
(hierarchy--add-relation hierarchy item parent acceptfn)
- (hierarchy-add-tree hierarchy parent parentfn childrenfn)))
- (let ((children (and childrenfn (funcall childrenfn item))))
- (mapc (lambda (child)
- (when (funcall acceptfn child)
- (hierarchy--add-relation hierarchy child item acceptfn)
- (hierarchy-add-tree hierarchy child parentfn childrenfn)))
- children)))))
-
-(defun hierarchy-add-trees (hierarchy items parentfn &optional childrenfn
acceptfn)
+ (hierarchy-add-tree hierarchy parent
+ parentfn (if delay-children-p nil childrenfn))))
+ (if (and childrenfn delay-children-p)
+ (map-put! (hierarchy--delaying-parents hierarchy) item childrenfn)
+ (let ((children (and childrenfn (funcall childrenfn item))))
+ (map-put! (hierarchy--delaying-parents hierarchy) item nil)
+ (mapc (lambda (child)
+ (when (funcall acceptfn child)
+ (hierarchy--add-relation hierarchy child item acceptfn)
+ (hierarchy-add-tree hierarchy child parentfn childrenfn)))
+ children))))))
+
+(defun hierarchy-add-trees (hierarchy items parentfn
+ &optional childrenfn acceptfn
delay-children-p)
"Call `hierarchy-add-tree' on HIERARCHY and each element of ITEMS.
-PARENTFN, CHILDRENFN and ACCEPTFN have the same meaning as in `hierarchy-add'."
+PARENTFN, CHILDRENFN, ACCEPTFN, and DELAY-CHILDREN-P have the same meaning as
in
+`hierarchy-add'."
(seq-map (lambda (item)
- (hierarchy-add-tree hierarchy item parentfn childrenfn acceptfn))
+ (hierarchy-add-tree hierarchy item parentfn
+ childrenfn acceptfn delay-children-p))
items))
(defun hierarchy-add-list (hierarchy list &optional wrap childrenfn)
"Add to HIERARCHY the sub-lists in LIST.
-If WRAP is non-nil, allow duplicate items in LIST by wraping each
+If WRAP is non-nil, allow duplicate items in LIST by wrapping each
item in a cons (id . item). The root's id is 1.
CHILDRENFN is a function (defaults to `cdr') taking LIST as a
@@ -541,6 +555,30 @@ nil. The buffer is returned."
buffer))
(declare-function widget-convert "wid-edit")
+(defun hierarchy--create-delayed-tree-widget (elem labelfn indent childrenfn)
+ "Return a list of tree-widgets for the children generated.
+
+ELEM is the element of the hierarchy passed from
+`hierarchy-convert-to-tree-widget'; it and the CHILDRENFN are used to generate
+the children of the element dynamically.
+
+LABELFN is the same function passed to `hierarchy-convert-to-tree-widget'.
+
+INDENT is the same function passed to `hierarchy-convert-to-tree-widget'.
+
+CHILDRENFN is the function used to discover the children of ELEM."
+ (lambda (_widget)
+ (mapcar
+ (lambda (item)
+ (widget-convert
+ 'tree-widget
+ :tag (hierarchy-labelfn-to-string labelfn item indent)
+ :expander (hierarchy--create-delayed-tree-widget
+ item
+ labelfn
+ (1+ indent)
+ childrenfn)))
+ (funcall childrenfn elem))))
(defun hierarchy-convert-to-tree-widget (hierarchy labelfn)
"Return a tree-widget for HIERARCHY.
@@ -550,10 +588,21 @@ node label."
(require 'wid-edit)
(require 'tree-widget)
(hierarchy-map-tree (lambda (item indent children)
- (widget-convert
- 'tree-widget
- :tag (hierarchy-labelfn-to-string labelfn item indent)
- :args children))
+ (let ((childrenfn (map-elt
+ (hierarchy--delaying-parents
hierarchy)
+ item)))
+ (apply
+ #'widget-convert
+ (list 'tree-widget
+ :tag (hierarchy-labelfn-to-string labelfn
item indent)
+ (if childrenfn :expander :args)
+ (if childrenfn
+ (hierarchy--create-delayed-tree-widget
+ item
+ labelfn
+ (1+ indent)
+ childrenfn)
+ children)))))
hierarchy))
(defun hierarchy-tree-display (hierarchy labelfn &optional buffer)
diff --git a/lisp/emacs-lisp/icons.el b/lisp/emacs-lisp/icons.el
index a08ac7463c..86c4483030 100644
--- a/lisp/emacs-lisp/icons.el
+++ b/lisp/emacs-lisp/icons.el
@@ -196,18 +196,21 @@ present if the icon is represented by an image."
(image-supported-file-p file)
(propertize
" " 'display
- (if-let ((height (plist-get keywords :height)))
- (create-image file
- nil nil
- :height (if (eq height 'line)
+ (let ((props
+ (append
+ (if-let ((height (plist-get keywords :height)))
+ (list :height (if (eq height 'line)
(window-default-line-height)
- height)
- :scale 1
- :rotation (or (plist-get keywords :rotation) 0)
- :ascent (if (plist-member keywords :ascent)
- (plist-get keywords :ascent)
- 'center))
- (create-image file))))))
+ height)))
+ '(:scale 1)
+ (if-let ((rotation (plist-get keywords :rotation)))
+ (list :rotation rotation))
+ (if-let ((margin (plist-get keywords :margin)))
+ (list :margin margin))
+ (list :ascent (if (plist-member keywords :ascent)
+ (plist-get keywords :ascent)
+ 'center)))))
+ (apply 'create-image file nil nil props))))))
(cl-defmethod icons--create ((_type (eql 'emoji)) icon _keywords)
(when-let ((font (and (display-multi-font-p)
diff --git a/lisp/emacs-lisp/loaddefs-gen.el b/lisp/emacs-lisp/loaddefs-gen.el
index 964d23c770..ecc5f7e47b 100644
--- a/lisp/emacs-lisp/loaddefs-gen.el
+++ b/lisp/emacs-lisp/loaddefs-gen.el
@@ -283,6 +283,12 @@ expression, in which case we want to handle forms
differently."
,@(when-let ((safe (plist-get props :safe)))
`((put ',varname 'safe-local-variable ,safe))))))
+ ;; Extract theme properties.
+ ((eq car 'deftheme)
+ (let* ((name (car-safe (cdr-safe form)))
+ (props (nthcdr 3 form)))
+ `(put ',name 'theme-properties (list ,@props))))
+
((eq car 'defgroup)
;; In Emacs this is normally handled separately by cus-dep.el, but for
;; third party packages, it can be convenient to explicitly autoload
@@ -730,7 +736,14 @@ rules for built-in packages and excluded files."
;; updated.
(file-newer-than-file-p
(expand-file-name "emacs-lisp/loaddefs-gen.el" lisp-directory)
- output-file))))
+ output-file)))
+ (let ((lisp-mode-autoload-regexp
+ "^;;;###\\(\\(noexist\\)-\\)?\\(theme-autoload\\)"))
+ (loaddefs-generate
+ (expand-file-name "../etc/themes/" lisp-directory)
+ (expand-file-name "theme-loaddefs.el" lisp-directory))))
+
+;;;###autoload (load "theme-loaddefs.el" t)
(provide 'loaddefs-gen)
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 8c67d7c7a2..8e3b698d37 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -5,7 +5,7 @@
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: extensions, lisp
-;; Version: 3.2.1
+;; Version: 3.3.1
;; Package-Requires: ((emacs "26"))
;; This file is part of GNU Emacs.
@@ -80,48 +80,82 @@ MAP can be an alist, plist, hash-table, or array."
`(pcase-let ((,(map--make-pcase-patterns keys) ,map))
,@body))
-(eval-when-compile
- (defmacro map--dispatch (map-var &rest args)
- "Evaluate one of the forms specified by ARGS based on the type of MAP-VAR.
-
-The following keyword types are meaningful: `:list',
-`:hash-table' and `:array'.
-
-An error is thrown if MAP-VAR is neither a list, hash-table nor array.
-
-Returns the result of evaluating the form associated with MAP-VAR's type."
- (declare (debug t) (indent 1))
- `(cond ((listp ,map-var) ,(plist-get args :list))
- ((hash-table-p ,map-var) ,(plist-get args :hash-table))
- ((arrayp ,map-var) ,(plist-get args :array))
- (t (error "Unsupported map type `%S': %S"
- (type-of ,map-var) ,map-var)))))
-
(define-error 'map-not-inplace "Cannot modify map in-place")
(defsubst map--plist-p (list)
+ "Return non-nil if LIST is the start of a nonempty plist map."
(and (consp list) (atom (car list))))
+(defconst map--plist-has-predicate
+ (condition-case nil
+ (with-no-warnings (plist-get () nil #'eq) t)
+ (wrong-number-of-arguments))
+ "Non-nil means `plist-get' & co. accept a predicate in Emacs 29+.
+Note that support for this predicate in map.el is patchy and
+deprecated.")
+
+(defun map--plist-member-1 (plist prop &optional predicate)
+ "Compatibility shim for the PREDICATE argument of `plist-member'.
+Assumes non-nil PLIST satisfies `map--plist-p'."
+ (if (or (memq predicate '(nil eq)) (null plist))
+ (plist-member plist prop)
+ (let ((tail plist) found)
+ (while (and (not (setq found (funcall predicate (car tail) prop)))
+ (consp (setq tail (cdr tail)))
+ (consp (setq tail (cdr tail)))))
+ (and tail (not found)
+ (signal 'wrong-type-argument `(plistp ,plist)))
+ tail)))
+
+(defalias 'map--plist-member
+ (if map--plist-has-predicate #'plist-member #'map--plist-member-1)
+ "Compatibility shim for `plist-member' in Emacs 29+.
+\n(fn PLIST PROP &optional PREDICATE)")
+
+(defun map--plist-put-1 (plist prop val &optional predicate)
+ "Compatibility shim for the PREDICATE argument of `plist-put'.
+Assumes non-nil PLIST satisfies `map--plist-p'."
+ (if (or (memq predicate '(nil eq)) (null plist))
+ (plist-put plist prop val)
+ (let ((tail plist) prev found)
+ (while (and (consp (cdr tail))
+ (not (setq found (funcall predicate (car tail) prop)))
+ (consp (setq prev tail tail (cddr tail)))))
+ (cond (found (setcar (cdr tail) val))
+ (tail (signal 'wrong-type-argument `(plistp ,plist)))
+ (prev (setcdr (cdr prev) (cons prop (cons val (cddr prev)))))
+ ((setq plist (cons prop (cons val plist)))))
+ plist)))
+
+(defalias 'map--plist-put
+ (if map--plist-has-predicate #'plist-put #'map--plist-put-1)
+ "Compatibility shim for `plist-put' in Emacs 29+.
+\n(fn PLIST PROP VAL &optional PREDICATE)")
+
(cl-defgeneric map-elt (map key &optional default testfn)
"Look up KEY in MAP and return its associated value.
If KEY is not found, return DEFAULT which defaults to nil.
TESTFN is the function to use for comparing keys. It is
deprecated because its default and valid values depend on the MAP
-argument. Generally, alist keys are compared with `equal', plist
-keys with `eq', and hash-table keys with the hash-table's test
+argument, and it was never consistently supported by the map.el
+API. Generally, alist keys are compared with `equal', plist keys
+with `eq', and hash-table keys with the hash-table's test
function.
In the base definition, MAP can be an alist, plist, hash-table,
or array."
(declare
+ ;; `testfn' is deprecated.
+ (advertised-calling-convention (map key &optional default) "27.1")
(gv-expander
(lambda (do)
(gv-letplace (mgetter msetter) `(gv-delay-error ,map)
(macroexp-let2* nil
;; Eval them once and for all in the right order.
((key key) (default default) (testfn testfn))
- (funcall do `(map-elt ,mgetter ,key ,default)
+ (funcall do
+ `(map-elt ,mgetter ,key ,default ,@(and testfn `(,testfn)))
(lambda (v)
(macroexp-let2 nil v v
`(condition-case nil
@@ -132,19 +166,21 @@ or array."
,(funcall msetter
`(map-insert ,mgetter ,key ,v))
;; Always return the value.
- ,v)))))))))
- ;; `testfn' is deprecated.
- (advertised-calling-convention (map key &optional default) "27.1"))
- ;; Can't use `cl-defmethod' with `advertised-calling-convention'.
- (map--dispatch map
- :list (if (map--plist-p map)
- (let ((res (plist-member map key)))
- (if res (cadr res) default))
- (alist-get key map default nil (or testfn #'equal)))
- :hash-table (gethash key map default)
- :array (if (map-contains-key map key)
- (aref map key)
- default)))
+ ,v)))))))))))
+
+(cl-defmethod map-elt ((map list) key &optional default testfn)
+ (if (map--plist-p map)
+ (let ((res (map--plist-member map key testfn)))
+ (if res (cadr res) default))
+ (alist-get key map default nil (or testfn #'equal))))
+
+(cl-defmethod map-elt ((map hash-table) key &optional default _testfn)
+ (gethash key map default))
+
+(cl-defmethod map-elt ((map array) key &optional default _testfn)
+ (if (map-contains-key map key)
+ (aref map key)
+ default))
(defmacro map-put (map key value &optional testfn)
"Associate KEY with VALUE in MAP and return VALUE.
@@ -154,8 +190,12 @@ When MAP is an alist, test equality with TESTFN if non-nil,
otherwise use `equal'.
MAP can be an alist, plist, hash-table, or array."
- (declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead"
"27.1"))
- `(setf (map-elt ,map ,key nil ,testfn) ,value))
+ (declare
+ (obsolete "use `map-put!' or `(setf (map-elt ...) ...)' instead." "27.1"))
+ (if testfn
+ `(with-no-warnings
+ (setf (map-elt ,map ,key nil ,testfn) ,value))
+ `(setf (map-elt ,map ,key) ,value)))
(defun map--plist-delete (map key)
(let ((tail map) last)
@@ -338,15 +378,16 @@ The default implementation delegates to `map-length'."
"Return non-nil if and only if MAP contains KEY.
TESTFN is deprecated. Its default depends on MAP.
The default implementation delegates to `map-some'."
+ (declare (advertised-calling-convention (map key) "27.1"))
(unless testfn (setq testfn #'equal))
(map-some (lambda (k _v) (funcall testfn key k)) map))
(cl-defmethod map-contains-key ((map list) key &optional testfn)
"Return non-nil if MAP contains KEY.
If MAP is an alist, TESTFN defaults to `equal'.
-If MAP is a plist, `plist-member' is used instead."
+If MAP is a plist, TESTFN defaults to `eq'."
(if (map--plist-p map)
- (plist-member map key)
+ (map--plist-member map key testfn)
(let ((v '(nil)))
(not (eq v (alist-get key map v nil (or testfn #'equal)))))))
@@ -459,24 +500,30 @@ This operates by modifying MAP in place.
If it cannot do that, it signals a `map-not-inplace' error.
To insert an element without modifying MAP, use `map-insert'."
;; `testfn' only exists for backward compatibility with `map-put'!
- (declare (advertised-calling-convention (map key value) "27.1"))
- ;; Can't use `cl-defmethod' with `advertised-calling-convention'.
- (map--dispatch
- map
- :list
- (progn
- (if (map--plist-p map)
- (plist-put map key value)
- (let ((oldmap map))
- (setf (alist-get key map key nil (or testfn #'equal)) value)
- (unless (eq oldmap map)
- (signal 'map-not-inplace (list oldmap)))))
- ;; Always return the value.
- value)
- :hash-table (puthash key value map)
- ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
- ;; and let `map-insert' grow the array?
- :array (aset map key value)))
+ (declare (advertised-calling-convention (map key value) "27.1")))
+
+(cl-defmethod map-put! ((map list) key value &optional testfn)
+ (if (map--plist-p map)
+ (map--plist-put map key value testfn)
+ (let ((oldmap map))
+ (setf (alist-get key map key nil (or testfn #'equal)) value)
+ (unless (eq oldmap map)
+ (signal 'map-not-inplace (list oldmap)))))
+ ;; Always return the value.
+ value)
+
+(cl-defmethod map-put! ((map hash-table) key value &optional _testfn)
+ (puthash key value map))
+
+(cl-defmethod map-put! ((map array) key value &optional _testfn)
+ ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
+ ;; and let `map-insert' grow the array?
+ (aset map key value))
+
+;; There shouldn't be old source code referring to `map--put', yet we do
+;; need to keep it for backward compatibility with .elc files where the
+;; expansion of `setf' may call this function.
+(define-obsolete-function-alias 'map--put #'map-put! "27.1")
(cl-defgeneric map-insert (map key value)
"Return a new map like MAP except that it associates KEY with VALUE.
@@ -493,11 +540,6 @@ The default implementation defaults to `map-copy' and
`map-put!'."
(cons key (cons value map))
(cons (cons key value) map)))
-;; There shouldn't be old source code referring to `map--put', yet we do
-;; need to keep it for backward compatibility with .elc files where the
-;; expansion of `setf' may call this function.
-(define-obsolete-function-alias 'map--put #'map-put! "27.1")
-
(cl-defmethod map-apply (function (map list))
(if (map--plist-p map)
(cl-call-next-method)
diff --git a/lisp/emacs-lisp/memory-report.el b/lisp/emacs-lisp/memory-report.el
index 56b1ea6ed4..968a80b59e 100644
--- a/lisp/emacs-lisp/memory-report.el
+++ b/lisp/emacs-lisp/memory-report.el
@@ -262,12 +262,7 @@ by counted more than once."
(cl-struct-slot-info struct-type)))))
(defun memory-report--format (bytes)
- (setq bytes (/ bytes 1024.0))
- (let ((units '("KiB" "MiB" "GiB" "TiB")))
- (while (>= bytes 1024)
- (setq bytes (/ bytes 1024.0))
- (setq units (cdr units)))
- (format "%6.1f %s" bytes (car units))))
+ (format "%10s" (file-size-human-readable bytes 'iec " ")))
(defun memory-report--gc-elem (elems type)
(* (nth 1 (assq type elems))
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
index d6f1ab98fa..9d6e8c0d88 100644
--- a/lisp/emacs-lisp/multisession.el
+++ b/lisp/emacs-lisp/multisession.el
@@ -19,7 +19,18 @@
;;; Commentary:
+;; This library provides multisession variables for Emacs Lisp, to
+;; make them persist between sessions.
;;
+;; Use `define-multisession-variable' to define a multisession
+;; variable, and `multisession-value' to read its value. Use
+;; `list-multisession-values' to list multisession variables.
+;;
+;; Users might want to customize `multisession-storage' and
+;; `multisession-directory'.
+;;
+;; See Info node `(elisp) Multisession Variables' for more
+;; information.
;;; Code:
diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el
index c77ac151d7..a17fdb7e35 100644
--- a/lisp/emacs-lisp/oclosure.el
+++ b/lisp/emacs-lisp/oclosure.el
@@ -216,7 +216,7 @@ is a list of additional properties among the following:
function) named COPIER. It will take an object of type NAME as first
argument followed by ARGS. ARGS lists the names of the slots that will
be updated with the value of the corresponding argument.
-SLOTS is a list if slot descriptions. Each slot can be a single symbol
+SLOTS is a list of slot descriptions. Each slot can be a single symbol
which is the name of the slot, or it can be of the form (SLOT-NAME . SPROPS)
where SLOT-NAME is then the name of the slot and SPROPS is a property
list of slot properties. The currently known properties are the following:
@@ -341,11 +341,11 @@ list of slot properties. The currently known properties
are the following:
(defmacro oclosure--lambda (type bindings mutables args &rest body)
"Low level construction of an OClosure object.
-TYPE should be a form returning an OClosure type (a symbol)
+TYPE should be a form returning an OClosure type (a symbol).
BINDINGS should list all the slots expected by this type, in the proper order.
MUTABLE is a list of symbols indicating which of the BINDINGS
should be mutable.
-No checking is performed,"
+No checking is performed."
(declare (indent 3) (debug (sexp (&rest (sexp form)) sexp def-body)))
;; FIXME: Fundamentally `oclosure-lambda' should be a special form.
;; We define it here as a macro which expands to something that
diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el
new file mode 100644
index 0000000000..a999596785
--- /dev/null
+++ b/lisp/emacs-lisp/package-vc.el
@@ -0,0 +1,791 @@
+;;; package-vc.el --- Manage packages from VC checkouts -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Philip Kaludercic <philipk@posteo.net>
+;; Keywords: tools
+
+;; 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/>.
+
+;;; Commentary:
+
+;; While packages managed by package.el use tarballs for distributing
+;; the source code, this extension allows for packages to be fetched
+;; and updated directly from a version control system.
+;;
+;; To install a package from source use `package-vc-install'. If you
+;; aren't interested in activating a package, you can use
+;; `package-vc-checkout' instead, which will prompt you for a target
+;; directory. If you wish to re-use an existing checkout, the command
+;; `package-vc-install-from-checkout' will create a symbolic link and
+;; prepare the package.
+;;
+;; If you make local changes that you wish to share with an upstream
+;; maintainer, the command `package-vc-prepare-patch' can prepare
+;; these as patches to send via Email.
+
+;;; TODO:
+
+;; - Allow maintaining patches that are ported back onto regular
+;; packages and maintained between versions.
+;;
+;; - Add a heuristic for guessing a `:lisp-dir' when cloning directly
+;; from a URL.
+
+;;; Code:
+
+(eval-when-compile (require 'rx))
+(eval-when-compile (require 'inline))
+(eval-when-compile (require 'map))
+(require 'package)
+(require 'lisp-mnt)
+(require 'vc)
+(require 'seq)
+
+(defgroup package-vc nil
+ "Manage packages from VC checkouts."
+ :group 'package
+ :link '(custom-manual "(emacs) Package from Source")
+ :prefix "package-vc-"
+ :version "29.1")
+
+(defconst package-vc--elpa-packages-version 1
+ "Version number of the package specification format understood by
package-vc.")
+
+(defcustom package-vc-heuristic-alist
+ `((,(rx bos "http" (? "s") "://"
+ (or (: (? "www.") "github.com"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "codeberg.org"
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: (? "www.") "gitlab" (+ "." (+ alnum))
+ "/" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "git.sr.ht"
+ "/~" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "git." (or "savannah" "sv") "." (? "non") "gnu.org/"
+ (or "r" "git") "/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ (or (? "/") ".git") eos)
+ . Git)
+ (,(rx bos "http" (? "s") "://"
+ (or (: "hg.sr.ht"
+ "/~" (+ (or alnum "-" "." "_"))
+ "/" (+ (or alnum "-" "." "_")))
+ (: "hg." (or "savannah" "sv") "." (? "non") "gnu.org/hgweb/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ eos)
+ . Hg)
+ (,(rx bos "http" (? "s") "://"
+ (or (: "bzr." (or "savannah" "sv") "." (? "non") "gnu.org/r/"
+ (+ (or alnum "-" "." "_")) (? "/")))
+ eos)
+ . Bzr))
+ "Heuristic mapping URL regular expressions to VC backends."
+ :type `(alist :key-type (regexp :tag "Regular expression matching URLs")
+ :value-type (choice :tag "VC Backend"
+ ,@(mapcar (lambda (b) `(const ,b))
+ vc-handled-backends)))
+ :version "29.1")
+
+(defcustom package-vc-default-backend 'Git
+ "Default VC backend used when cloning a package repository.
+If no repository type was specified or could be guessed by
+`package-vc-heuristic-alist', this is the default VC backend
+used as fallback. The value must be a member of
+`vc-handled-backends' and the named backend must implement
+the `clone' function."
+ :type `(choice ,@(mapcar (lambda (b) (list 'const b))
+ vc-handled-backends))
+ :version "29.1")
+
+(defvar package-vc-selected-packages) ; pacify byte-compiler
+
+;;;###autoload
+(defun package-vc-install-selected-packages ()
+ "Ensure packages specified in `package-vc-selected-packages' are installed."
+ (interactive)
+ (pcase-dolist (`(,name . ,spec) package-vc-selected-packages)
+ (when (stringp name)
+ (setq name (intern name)))
+ (let ((pkg-descs (assoc name package-alist #'string=)))
+ (unless (seq-some #'package-vc-p (cdr pkg-descs))
+ (cond
+ ((null spec)
+ (package-vc-install name))
+ ((stringp spec)
+ (package-vc-install name nil spec))
+ ((listp spec)
+ (package-vc--archives-initialize)
+ (package-vc--unpack (cadr pkg-descs) spec)))))))
+
+;;;###autoload
+(defcustom package-vc-selected-packages '()
+ "List of packages that must be installed.
+Each member of the list is of the form (NAME . SPEC), where NAME
+is a symbol designating the package and SPEC is one of:
+
+- nil, if any package version can be installed;
+- a version string, if that specific revision is to be installed;
+- a property list, describing a package specification. Valid
+ key/value pairs are
+
+ `:url' (string)
+ The URL of the repository used to fetch the package source.
+
+ `:branch' (string)
+ If given, the name of the branch to checkout after cloning the directory.
+
+ `:lisp-dir' (string)
+ The repository-relative name of the directory to use for loading the Lisp
+ sources. If not given, the value defaults to the root directory
+ of the repository.
+
+ `:main-file' (string)
+ The main file of the project, relevant to gather package metadata.
+ If not given, the assumed default is the package name with \".el\"
+ appended to it.
+
+ `:vc-backend' (symbol)
+ A symbol of the VC backend to use for cloning the package. The
+ value ought to be a member of `vc-handled-backends'. If omitted,
+ `vc-clone' will fall back onto the archive default or on
+ `package-vc-default-backend'.
+
+ All other keys are ignored.
+
+This user option differs from `package-selected-packages' in that
+it is meant to be specified manually. If you want to install all
+the packages in the list, you cal also use
+`package-vc-install-selected-packages'.
+
+Note that this option will not override an existing source
+package installation or revert the checked out revision."
+ :type '(alist :tag "List of packages you want to be installed"
+ :key-type (symbol :tag "Package")
+ :value-type
+ (choice (const :tag "Any revision" nil)
+ (string :tag "Specific revision")
+ (plist :options ((:url string)
+ (:branch string)
+ (:lisp-dir string)
+ (:main-file string)
+ (:vc-backend symbol)))))
+ :initialize #'custom-initialize-default
+ :set (lambda (sym val)
+ (custom-set-default sym val)
+ (package-vc-install-selected-packages))
+ :version "29.1")
+
+(defvar package-vc--archive-spec-alist nil
+ "List of package specifications for each archive.
+The list maps each package name, as a string, to a plist as
+specified in `package-vc-selected-packages'.")
+
+(defvar package-vc--archive-data-alist nil
+ "List of package specification metadata for archives.
+Each element of the list has the form (ARCHIVE . PLIST), where
+PLIST keys are one of:
+
+ `:version' (integer)
+ Indicates the version of the file formatting, to be compared
+ with `package-vc--elpa-packages-version'.
+
+ `:vc-backend' (symbol)
+ A symbol of the default VC backend to use if a package specification
+ does not indicate a backend. The value ought to be a member of
+ `vc-handled-backends'. If omitted, `vc-clone' will fall back on
+ `package-vc-default-backend'.
+
+All other values are ignored.")
+
+(defun package-vc--desc->spec (pkg-desc &optional name)
+ "Retrieve the package specification for PKG-DESC.
+The optional argument NAME can be used to override the default
+name for PKG-DESC."
+ (alist-get
+ (or name (package-desc-name pkg-desc))
+ (if (package-desc-archive pkg-desc)
+ (alist-get (intern (package-desc-archive pkg-desc))
+ package-vc--archive-spec-alist)
+ (apply #'append (mapcar #'cdr package-vc--archive-spec-alist)))
+ nil nil #'string=))
+
+(define-inline package-vc--query-spec (pkg-desc prop)
+ "Query the property PROP for the package specification of PKG-DESC.
+If no package specification can be determined, the function will
+return nil."
+ (inline-letevals (pkg-desc prop)
+ (inline-quote (plist-get (package-vc--desc->spec ,pkg-desc) ,prop))))
+
+(defun package-vc--read-archive-data (archive)
+ "Update `package-vc--archive-spec-alist' for ARCHIVE.
+This function is meant to be used as a hook for `package-read-archive-hook'."
+ (let ((contents-file (expand-file-name
+ (format "archives/%s/elpa-packages.eld" archive)
+ package-user-dir)))
+ (when (file-exists-p contents-file)
+ (with-temp-buffer
+ (let ((coding-system-for-read 'utf-8))
+ (insert-file-contents contents-file)
+ ;; The response from the server is expected to have the form
+ ;;
+ ;; ((("foo" :url "..." ...) ...)
+ ;; :version 1
+ ;; :default-vc Git)
+ (let ((spec (read (current-buffer))))
+ (when (eq package-vc--elpa-packages-version
+ (plist-get (cdr spec) :version))
+ (setf (alist-get (intern archive) package-vc--archive-spec-alist)
+ (car spec)))
+ (setf (alist-get (intern archive) package-vc--archive-data-alist)
+ (cdr spec))
+ (when-let ((default-vc (plist-get (cdr spec) :default-vc))
+ ((not (memq default-vc vc-handled-backends))))
+ (warn "Archive `%S' expects missing VC backend %S"
+ archive (plist-get (cdr spec) :default-vc)))))))))
+
+(defun package-vc--download-and-read-archives (&optional async)
+ "Download specifications of all `package-archives' and read them.
+Populate `package-vc--archive-spec-alist' with the result.
+
+If optional argument ASYNC is non-nil, perform the downloads
+asynchronously."
+ (dolist (archive package-archives)
+ (condition-case-unless-debug nil
+ (package--download-one-archive archive "elpa-packages.eld" async)
+ (error (message "Failed to download `%s' archive." (car archive))))))
+
+(add-hook 'package-read-archive-hook #'package-vc--read-archive-data 20)
+
+(defun package-vc-commit (pkg)
+ "Return the last commit of a development package PKG."
+ (cl-assert (package-vc-p pkg))
+ ;; FIXME: vc should be extended to allow querying the commit of a
+ ;; directory (as is possible when dealing with git repositories).
+ ;; This should be a fallback option.
+ (cl-loop with dir = (package-desc-dir pkg)
+ for file in (directory-files dir t "\\.el\\'" t)
+ when (vc-working-revision file) return it
+ finally return "unknown"))
+
+(defun package-vc--version (pkg)
+ "Return the version number for the source package PKG."
+ (cl-assert (package-vc-p pkg))
+ (if-let ((main-file (package-vc--main-file pkg)))
+ (with-temp-buffer
+ (insert-file-contents main-file)
+ (package-strip-rcs-id
+ (or (lm-header "package-version")
+ (lm-header "version"))))
+ "0"))
+
+(defun package-vc--main-file (pkg-desc)
+ "Return the name of the main file for PKG-DESC."
+ (cl-assert (package-vc-p pkg-desc))
+ (let ((pkg-spec (package-vc--desc->spec pkg-desc))
+ (name (symbol-name (package-desc-name pkg-desc))))
+ (or (plist-get pkg-spec :main-file)
+ (expand-file-name
+ (concat name ".el")
+ (file-name-concat
+ (or (package-desc-dir pkg-desc)
+ (expand-file-name name package-user-dir))
+ (plist-get pkg-spec :lisp-dir))))))
+
+(defun package-vc--generate-description-file (pkg-desc pkg-file)
+ "Generate a package description file for PKG-DESC and write it to PKG-FILE."
+ (let ((name (package-desc-name pkg-desc)))
+ ;; Infer the subject if missing.
+ (unless (package-desc-summary pkg-desc)
+ (setf (package-desc-summary pkg-desc)
+ (let ((main-file (package-vc--main-file pkg-desc)))
+ (or (package-desc-summary pkg-desc)
+ (and-let* ((pkg (cadr (assq name package-archive-contents))))
+ (package-desc-summary pkg))
+ (and main-file (file-exists-p main-file)
+ (lm-summary main-file))
+ package--default-summary))))
+ (let ((print-level nil)
+ (print-quoted t)
+ (print-length nil))
+ (write-region
+ (concat
+ ";;; Generated package description from "
+ (replace-regexp-in-string
+ "-pkg\\.el\\'" ".el"
+ (file-name-nondirectory pkg-file))
+ " -*- no-byte-compile: t -*-\n"
+ (prin1-to-string
+ (nconc
+ (list 'define-package
+ (symbol-name name)
+ (cons 'vc (package-vc--version pkg-desc))
+ (package-desc-summary pkg-desc)
+ (let ((requires (package-desc-reqs pkg-desc)))
+ (list 'quote
+ ;; Turn version lists into string form.
+ (mapcar
+ (lambda (elt)
+ (list (car elt)
+ (package-version-join (cadr elt))))
+ requires))))
+ (package--alist-to-plist-args
+ (package-desc-extras pkg-desc))))
+ "\n")
+ nil pkg-file nil 'silent))))
+
+(declare-function org-export-to-file "ox" (backend file))
+
+(defun package-vc--build-documentation (pkg-desc file)
+ "Build documentation for package PKG-DESC from documentation source in FILE.
+FILE can be an Org file, indicated by its \".org\" extension,
+otherwise it's assumed to be an Info file."
+ (let* ((pkg-name (package-desc-name pkg-desc))
+ (default-directory (package-desc-dir pkg-desc))
+ (output (expand-file-name (format "%s.info" pkg-name)))
+ clean-up)
+ (when (string-match-p "\\.org\\'" file)
+ (require 'ox)
+ (require 'ox-texinfo)
+ (with-temp-buffer
+ (insert-file-contents file)
+ (setq file (make-temp-file "ox-texinfo-"))
+ (org-export-to-file 'texinfo file)
+ (setq clean-up t)))
+ (with-current-buffer (get-buffer-create " *package-vc doc*")
+ (erase-buffer)
+ (cond
+ ((/= 0 (call-process "makeinfo" nil t nil
+ "--no-split" file "-o" output))
+ (message "Failed to build manual %s, see buffer %S"
+ file (buffer-name)))
+ ((/= 0 (call-process "install-info" nil t nil
+ output (expand-file-name "dir")))
+ (message "Failed to install manual %s, see buffer %S"
+ output (buffer-name)))
+ ((kill-buffer))))
+ (when clean-up
+ (delete-file file))))
+
+(defun package-vc--unpack-1 (pkg-desc pkg-dir)
+ "Prepare PKG-DESC that is already checked-out in PKG-DIR.
+This includes downloading missing dependencies, generating
+autoloads, generating a package description file (used to
+identify a package as a source package later on), building
+documentation and marking the package as installed."
+ ;; Remove any previous instance of PKG-DESC from `package-alist'
+ (let ((pkgs (assq (package-desc-name pkg-desc) package-alist)))
+ (when pkgs
+ (setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs)))))
+
+ ;; In case the package was installed directly from source, the
+ ;; dependency list wasn't know beforehand, and they might have
+ ;; to be installed explicitly.
+ (let ((deps '()))
+ (dolist (file (directory-files pkg-dir t "\\.el\\'" t))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (when-let* ((require-lines (lm-header-multiline "package-requires")))
+ (thread-last
+ (mapconcat #'identity require-lines " ")
+ package-read-from-string
+ package--prepare-dependencies
+ (nconc deps)
+ (setq deps)))))
+ (dolist (dep deps)
+ (cl-callf version-to-list (cadr dep)))
+ (package-download-transaction
+ (package-compute-transaction nil (delete-dups deps))))
+
+ (let ((default-directory (file-name-as-directory pkg-dir))
+ (pkg-file (expand-file-name (package--description-file pkg-dir)
pkg-dir)))
+ ;; Generate autoloads
+ (let* ((name (package-desc-name pkg-desc))
+ (auto-name (format "%s-autoloads.el" name))
+ (extras (package-desc-extras pkg-desc))
+ (lisp-dir (alist-get :lisp-dir extras)))
+ (package-generate-autoloads
+ name (file-name-concat pkg-dir lisp-dir))
+ (when lisp-dir
+ (write-region
+ (with-temp-buffer
+ (insert ";; Autoload indirection for package-vc\n\n")
+ (prin1 `(load (expand-file-name
+ ,(file-name-concat lisp-dir auto-name)
+ (or (and load-file-name
+ (file-name-directory load-file-name))
+ (car load-path))))
+ (current-buffer))
+ (buffer-string))
+ nil (expand-file-name auto-name pkg-dir))))
+
+ ;; Generate package file
+ (package-vc--generate-description-file pkg-desc pkg-file)
+
+ ;; Detect a manual
+ (when-let ((pkg-spec (package-vc--desc->spec pkg-desc))
+ ((executable-find "install-info")))
+ (dolist (doc-file (ensure-list (plist-get pkg-spec :doc)))
+ (package-vc--build-documentation pkg-desc doc-file))))
+
+ ;; Update package-alist.
+ (let ((new-desc (package-load-descriptor pkg-dir)))
+ ;; Activation has to be done before compilation, so that if we're
+ ;; upgrading and macros have changed we load the new definitions
+ ;; before compiling.
+ (when (package-activate-1 new-desc :reload :deps)
+ ;; FIXME: Compilation should be done as a separate, optional, step.
+ ;; E.g. for multi-package installs, we should first install all packages
+ ;; and then compile them.
+ (package--compile new-desc)
+ (when package-native-compile
+ (package--native-compile-async new-desc))
+ ;; After compilation, load again any files loaded by
+ ;; `activate-1', so that we use the byte-compiled definitions.
+ (package--reload-previously-loaded new-desc)))
+
+ ;; Mark package as selected
+ (package--save-selected-packages
+ (cons (package-desc-name pkg-desc)
+ package-selected-packages))
+
+ ;; Confirm that the installation was successful
+ (let ((main-file (package-vc--main-file pkg-desc)))
+ (message "Source package `%s' installed (Version %s, Revision %S)."
+ (package-desc-name pkg-desc)
+ (lm-with-file main-file
+ (package-strip-rcs-id
+ (or (lm-header "package-version")
+ (lm-header "version"))))
+ (vc-working-revision main-file)))
+ t)
+
+(defun package-vc--guess-backend (url)
+ "Guess the VC backend for URL.
+This function will internally query `package-vc-heuristic-alist'
+and return nil if it cannot reasonably guess."
+ (and url (alist-get url package-vc-heuristic-alist
+ nil nil #'string-match-p)))
+
+(defun package-vc--clone (pkg-desc pkg-spec dir rev)
+ "Clone the package PKG-DESC whose spec is PKG-SPEC into the directory DIR.
+REV specifies a specific revision to checkout. This overrides the `:branch'
+attribute in PKG-SPEC."
+ (pcase-let* ((name (package-desc-name pkg-desc))
+ ((map :url :branch) pkg-spec))
+
+ ;; Clone the repository into `repo-dir' if necessary
+ (unless (file-exists-p dir)
+ (make-directory (file-name-directory dir) t)
+ (let ((backend (or (plist-get pkg-spec :vc-backend)
+ (package-vc--query-spec pkg-desc :vc-backend)
+ (package-vc--guess-backend url)
+ (plist-get (alist-get (package-desc-archive pkg-desc)
+ package-vc--archive-data-alist
+ nil nil #'string=)
+ :vc-backend)
+ package-vc-default-backend)))
+ (unless (vc-clone url backend dir
+ (or (and (not (eq rev :last-release)) rev) branch))
+ (error "Failed to clone %s from %s" name url))))
+
+ ;; Check out the latest release if requested
+ (when (eq rev :last-release)
+ (if-let ((release-rev (package-vc--release-rev pkg-desc)))
+ (vc-retrieve-tag dir release-rev)
+ (message "No release revision was found, continuing...")))))
+
+(defun package-vc--unpack (pkg-desc pkg-spec &optional rev)
+ "Install the package described by PKG-DESC.
+PKG-SPEC is a package specification, a property list describing
+how to fetch and build the package. See `package-vc--archive-spec-alist'
+for details. The optional argument REV specifies a specific revision to
+checkout. This overrides the `:branch' attribute in PKG-SPEC."
+ (pcase-let* (((map :lisp-dir) pkg-spec)
+ (name (package-desc-name pkg-desc))
+ (dirname (package-desc-full-name pkg-desc))
+ (pkg-dir (expand-file-name dirname package-user-dir)))
+ (setf (package-desc-dir pkg-desc) pkg-dir)
+ (when (file-exists-p pkg-dir)
+ (if (yes-or-no-p "Overwrite previous checkout?")
+ (package--delete-directory pkg-dir)
+ (error "There already exists a checkout for %s" name)))
+ (package-vc--clone pkg-desc pkg-spec pkg-dir rev)
+
+ (when lisp-dir
+ (push (cons :lisp-dir lisp-dir)
+ (package-desc-extras pkg-desc)))
+ (package-vc--unpack-1 pkg-desc pkg-dir)))
+
+(defun package-vc--read-package-name (prompt &optional allow-url installed)
+ "Query the user for a source package and return a name with PROMPT.
+If the optional argument ALLOW-URL is non-nil, the user is also
+allowed to specify a non-package name. If the optional argument
+INSTALLED is non-nil, the selection will be filtered down to
+source packages that have already been installed."
+ (package-vc--archives-initialize)
+ (completing-read prompt (if installed package-alist package-archive-contents)
+ (if installed
+ (lambda (pkg) (package-vc-p (cadr pkg)))
+ (lambda (pkg)
+ (or (package-vc--desc->spec (cadr pkg))
+ ;; If we have no explicit VC data, we can try a
kind of
+ ;; heuristic and use the URL header, that might
already be
+ ;; pointing towards a repository, and use that as a
backup
+ (and-let* ((extras (package-desc-extras (cadr pkg)))
+ (url (alist-get :url extras))
+ ((package-vc--guess-backend url)))))))
+ (not allow-url)))
+
+(defun package-vc--read-package-desc (prompt &optional installed)
+ "Query the user for a source package and return a description with PROMPT.
+If the optional argument INSTALLED is non-nil, the selection will
+be filtered down to source packages that have already been
+installed, and the package description will be that of an
+installed package."
+ (cadr (assoc (package-vc--read-package-name prompt nil installed)
+ (if installed package-alist package-archive-contents)
+ #'string=)))
+
+;;;###autoload
+(defun package-vc-update-all ()
+ "Attempt to update all installed VC packages."
+ (interactive)
+ (dolist (package package-alist)
+ (dolist (pkg-desc (cdr package))
+ (when (package-vc-p pkg-desc)
+ (package-vc-update pkg-desc))))
+ (message "Done updating packages."))
+
+;;;###autoload
+(defun package-vc-update (pkg-desc)
+ "Attempt to update the package PKG-DESC."
+ (interactive (list (package-vc--read-package-desc "Update source package: "
t)))
+ ;; HACK: To run `package-vc--unpack-1' after checking out the new
+ ;; revision, we insert a hook into `vc-post-command-functions', and
+ ;; remove it right after it ran. To avoid running the hook multiple
+ ;; times or even for the wrong repository (as `vc-pull' is often
+ ;; asynchronous), we extract the relevant arguments using a pseudo
+ ;; filter for `vc-filter-command-function', executed only for the
+ ;; side effect, and store them in the lexical scope. When the hook
+ ;; is run, we check if the arguments are the same (`eq') as the ones
+ ;; previously extracted, and only in that case will be call
+ ;; `package-vc--unpack-1'. Ugh...
+ ;;
+ ;; If there is a better way to do this, it should be done.
+ (cl-assert (package-vc-p pkg-desc))
+ (letrec ((pkg-dir (package-desc-dir pkg-desc))
+ (vc-flags)
+ (vc-filter-command-function
+ (lambda (command file-or-list flags)
+ (setq vc-flags flags)
+ (list command file-or-list flags)))
+ (post-upgrade
+ (lambda (_command _file-or-list flags)
+ (when (and (file-equal-p pkg-dir default-directory)
+ (eq flags vc-flags))
+ (unwind-protect
+ (with-demoted-errors "Failed to activate: %S"
+ (package-vc--unpack-1 pkg-desc pkg-dir))
+ (remove-hook 'vc-post-command-functions post-upgrade))))))
+ (add-hook 'vc-post-command-functions post-upgrade)
+ (with-demoted-errors "Failed to fetch: %S"
+ (let ((default-directory pkg-dir))
+ (vc-pull)))))
+
+(defun package-vc--archives-initialize ()
+ "Initialize package.el and fetch package specifications."
+ (package--archives-initialize)
+ (unless package-vc--archive-data-alist
+ (package-vc--download-and-read-archives)))
+
+(defun package-vc--release-rev (pkg-desc)
+ "Return the latest revision that bumps the \"Version\" tag for PKG-DESC.
+If no such revision can be found, return nil."
+ (with-current-buffer (find-file-noselect (package-vc--main-file pkg-desc))
+ (vc-buffer-sync)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search t))
+ (when (cond
+ ((re-search-forward
+ (concat (lm-get-header-re "package-version") ".*$")
+ (lm-code-start) t))
+ ((re-search-forward
+ (concat (lm-get-header-re "version") ".*$")
+ (lm-code-start) t)))
+ (ignore-error vc-not-supported
+ (vc-call-backend (vc-backend (buffer-file-name))
+ 'last-change
+ (buffer-file-name)
+ (line-number-at-pos nil t))))))))
+
+;;;###autoload
+(defun package-vc-install (package &optional name rev backend)
+ "Fetch a PACKAGE and set it up for using with Emacs.
+
+If PACKAGE is a string containing an URL, download the package
+from the repository at that URL; the function will try to guess
+the name of the package from the URL. This can be overridden by
+passing the optional argument NAME. If PACKAGE is a cons-cell,
+it should have the form (NAME . SPEC), where NAME is a symbol
+indicating the package name and SPEC is a plist as described in
+`package-vc-selected-packages'. Otherwise PACKAGE should be a
+symbol whose name is the package name, and the URL for the
+package will be taken from the package's metadata.
+
+By default, this function installs the last version of the package
+available from its repository, but if REV is given and non-nil, it
+specifies the revision to install. If REV has the special value
+`:last-release' (interactively, the prefix argument), that stands
+for the last released version of the package.
+
+Optional argument BACKEND specifies the VC backend to use for cloning
+the package's repository; this is only possible if NAME-OR-URL is a URL,
+a string. If BACKEND is omitted or nil, the function
+uses `package-vc-heuristic-alist' to guess the backend.
+Note that by default, a source package will be prioritized over a
+regular package, but it will not remove a source package."
+ (interactive
+ (progn
+ ;; Initialize the package system to get the list of package
+ ;; symbols for completion.
+ (package-vc--archives-initialize)
+ (let* ((name-or-url (package-vc--read-package-name
+ "Fetch and install package: " t))
+ (name (file-name-base name-or-url)))
+ (list name-or-url (intern (string-remove-prefix "emacs-" name))
+ (and current-prefix-arg :last-release)))))
+ (package-vc--archives-initialize)
+ (cond
+ ((null package)
+ (signal 'wrong-type-argument nil))
+ ((consp package)
+ (package-vc--unpack
+ (package-desc-create :name (car package)
+ :kind 'vc)
+ (cdr package)
+ rev))
+ ((and-let* (((stringp package))
+ (backend (or backend (package-vc--guess-backend package))))
+ (package-vc--unpack
+ (package-desc-create
+ :name (or name (intern (file-name-base package)))
+ :kind 'vc)
+ (list :vc-backend backend :url package)
+ rev)))
+ ((and-let* ((desc (assoc package package-archive-contents #'string=)))
+ (package-vc--unpack
+ (let ((copy (copy-package-desc (cadr desc))))
+ (setf (package-desc-kind copy) 'vc)
+ copy)
+ (or (package-vc--desc->spec (cadr desc))
+ (and-let* ((extras (package-desc-extras (cadr desc)))
+ (url (alist-get :url extras))
+ (backend (package-vc--guess-backend url)))
+ (list :vc-backend backend :url url))
+ (user-error "Package `%s' has no VC data" package))
+ rev)))
+ ((user-error "Unknown package to fetch: %s" package))))
+
+;;;###autoload
+(defun package-vc-checkout (pkg-desc directory &optional rev)
+ "Clone the sources for PKG-DESC into DIRECTORY and visit that directory.
+Unlike `package-vc-install', this does not yet set up the package
+for use with Emacs; use `package-vc-link-directory' for setting
+the package up after this function finishes.
+Optional argument REV means to clone a specific version of the
+package; it defaults to the last version available from the
+package's repository. If REV has the special value
+`:last-release' (interactively, the prefix argument), that stands
+for the last released version of the package."
+ (interactive
+ (let* ((name (package-vc--read-package-name "Fetch package source: ")))
+ (list (cadr (assoc name package-archive-contents #'string=))
+ (read-file-name "Clone into new or empty directory: " nil nil t nil
+ (lambda (dir) (or (not (file-exists-p dir))
+ (directory-empty-p dir))))
+ (and current-prefix-arg :last-release))))
+ (package-vc--archives-initialize)
+ (let ((pkg-spec (or (package-vc--desc->spec pkg-desc)
+ (and-let* ((extras (package-desc-extras pkg-desc))
+ (url (alist-get :url extras))
+ (backend (package-vc--guess-backend url)))
+ (list :vc-backend backend :url url))
+ (user-error "Package `%s' has no VC data"
+ (package-desc-name pkg-desc)))))
+ (package-vc--clone pkg-desc pkg-spec directory rev)
+ (find-file directory)))
+
+;;;###autoload
+(defun package-vc-install-from-checkout (dir name)
+ "Set up the package NAME in DIR by linking it into the ELPA directory.
+Interactively, prompt the user for DIR, which should be a directory
+under version control, typically one created by `package-vc-checkout'.
+If invoked interactively with a prefix argument, prompt the user
+for the NAME of the package to set up. Otherwise infer the package
+name from the base name of DIR."
+ (interactive (let ((dir (read-directory-name "Directory: ")))
+ (list dir
+ (if current-prefix-arg
+ (read-string "Package name: ")
+ (file-name-base (directory-file-name dir))))))
+ (unless (vc-responsible-backend dir)
+ (user-error "Directory %S is not under version control" dir))
+ (package-vc--archives-initialize)
+ (let* ((name (or name (file-name-base (directory-file-name dir))))
+ (pkg-dir (expand-file-name name package-user-dir)))
+ (make-symbolic-link (expand-file-name dir) pkg-dir)
+ (package-vc--unpack-1
+ (package-desc-create
+ :name (intern name)
+ :kind 'vc)
+ (file-name-as-directory pkg-dir))))
+
+;;;###autoload
+(defun package-vc-rebuild (pkg-desc)
+ "Rebuild the installation for package given by PKG-DESC.
+Rebuilding an installation means scraping for new autoload
+cookies, re-compiling Emacs Lisp files, building and installing
+any documentation, downloading any missing dependencies. This
+command does not fetch new revisions from a remote server. That
+is the responsibility of `package-vc-update'. Interactively,
+prompt for the name of the package to rebuild."
+ (interactive (list (package-vc--read-package-desc "Rebuild package: " t)))
+ (package-vc--unpack-1 pkg-desc (package-desc-dir pkg-desc)))
+
+;;;###autoload
+(defun package-vc-prepare-patch (pkg-desc subject revisions)
+ "Send patch for REVISIONS to maintainer of the package PKG using SUBJECT.
+The function uses `vc-prepare-patch', passing SUBJECT and
+REVISIONS directly. PKG-DESC must be a package description.
+Interactively, prompt for PKG-DESC, SUBJECT, and REVISIONS. When
+invoked with a numerical prefix argument, use the last N
+revisions. When invoked interactively in a Log View buffer with
+marked revisions, use those."
+ (interactive
+ (list (package-vc--read-package-desc "Package to prepare a patch for: " t)
+ (and (not vc-prepare-patches-separately)
+ (read-string "Subject: " "[PATCH] " nil nil t))
+ (vc-prepare-patch-prompt-revisions)))
+ (let ((default-directory (package-desc-dir pkg-desc)))
+ (vc-prepare-patch (package-maintainers pkg-desc t)
+ subject revisions)))
+
+(provide 'package-vc)
+;;; package-vc.el ends here
diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index 812e1eb0ff..c1545a2870 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -146,6 +146,7 @@
(require 'cl-lib)
(eval-when-compile (require 'subr-x))
(eval-when-compile (require 'epg)) ;For setf accessors.
+(eval-when-compile (require 'inline)) ;For `define-inline'
(require 'seq)
(require 'tabulated-list)
@@ -346,21 +347,28 @@ default directory."
(defcustom package-check-signature 'allow-unsigned
"Non-nil means to check package signatures when installing.
-More specifically the value can be:
-- nil: package signatures are ignored.
-- `allow-unsigned': install a package even if it is unsigned, but
- if it is signed, we have the key for it, and OpenGPG is
- installed, verify the signature.
-- t: accept a package only if it comes with at least one verified signature.
-- `all': same as t, except when the package has several signatures,
- in which case we verify all the signatures.
This also applies to the \"archive-contents\" file that lists the
-contents of the archive."
+contents of the archive.
+
+The value can be one of:
+
+ t Accept a package only if it comes with at least
+ one verified signature.
+
+ `all' Same as t, but verify all signatures if there
+ are more than one.
+
+ `allow-unsigned' Install a package even if it is unsigned,
+ but verify the signature if possible (that
+ is, if it is signed, we have the key for it,
+ and GnuPG is installed).
+
+ nil Package signatures are ignored."
:type '(choice (const :value nil :tag "Never")
(const :value allow-unsigned :tag "Allow unsigned")
(const :value t :tag "Check always")
- (const :value all :tag "Check all signatures"))
+ (const :value all :tag "Check always (all
signatures)"))
:risky t
:version "27.1")
@@ -449,6 +457,11 @@ synchronously."
(defvar package--default-summary "No description available.")
+(define-inline package-vc-p (pkg-desc)
+ "Return non-nil if PKG-DESC is a source package."
+ (inline-letevals (pkg-desc)
+ (inline-quote (eq (package-desc-kind ,pkg-desc) 'vc))))
+
(cl-defstruct (package-desc
;; Rename the default constructor from `make-package-desc'.
(:constructor package-desc-create)
@@ -461,14 +474,18 @@ synchronously."
&rest rest-plist
&aux
(name (intern name-string))
- (version (version-to-list version-string))
+ (version (if (eq (car-safe version-string) 'vc)
+ (version-to-list (cdr version-string))
+ (version-to-list version-string)))
(reqs (mapcar (lambda (elt)
(list (car elt)
(version-to-list (cadr elt))))
(if (eq 'quote (car requirements))
(nth 1 requirements)
requirements)))
- (kind (plist-get rest-plist :kind))
+ (kind (if (eq (car-safe version-string) 'vc)
+ 'vc
+ (plist-get rest-plist :kind)))
(archive (plist-get rest-plist :archive))
(extras (let (alist)
(while rest-plist
@@ -560,9 +577,11 @@ This is, approximately, the inverse of `version-to-list'.
(defun package-desc-full-name (pkg-desc)
"Return full name of package-desc object PKG-DESC.
This is the name of the package with its version appended."
- (format "%s-%s"
- (package-desc-name pkg-desc)
- (package-version-join (package-desc-version pkg-desc))))
+ (if (package-vc-p pkg-desc)
+ (symbol-name (package-desc-name pkg-desc))
+ (format "%s-%s"
+ (package-desc-name pkg-desc)
+ (package-version-join (package-desc-version pkg-desc)))))
(defun package-desc-suffix (pkg-desc)
"Return file-name extension of package-desc object PKG-DESC.
@@ -593,6 +612,25 @@ package."
"Return the priority of the archive of package-desc object PKG-DESC."
(package-archive-priority (package-desc-archive pkg-desc)))
+(defun package--parse-elpaignore (pkg-desc)
+ "Return the of regular expression to match files ignored by PKG-DESC."
+ (let* ((pkg-dir (file-name-as-directory (package-desc-dir pkg-desc)))
+ (ignore (expand-file-name ".elpaignore" pkg-dir))
+ files)
+ (when (file-exists-p ignore)
+ (with-temp-buffer
+ (insert-file-contents ignore)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (push (wildcard-to-regexp
+ (let ((line (buffer-substring
+ (line-beginning-position)
+ (line-end-position))))
+ (file-name-concat pkg-dir (string-trim-left line "/"))))
+ files)
+ (forward-line)))
+ files)))
+
(cl-defstruct (package--bi-desc
(:constructor package-make-builtin (version summary))
(:type vector))
@@ -641,6 +679,8 @@ loaded and/or activated, customize `package-load-list'.")
;; `package-load-all-descriptors', which ultimately populates the
;; `package-alist' variable.
+(declare-function package-vc-version "package-vc" (pkg))
+
(defun package-process-define-package (exp)
"Process define-package expression EXP and push it to `package-alist'.
EXP should be a form read from a foo-pkg.el file.
@@ -669,6 +709,8 @@ are sorted with the highest version first."
nil)))
new-pkg-desc)))
+(declare-function package-vc-commit "package-vc" (pkg))
+
(defun package-load-descriptor (pkg-dir)
"Load the package description file in directory PKG-DIR.
Create a new `package-desc' object, add it to `package-alist' and
@@ -699,11 +741,9 @@ description file containing a call to `define-package',
which
updates `package-alist'."
(dolist (dir (cons package-user-dir package-directory-list))
(when (file-directory-p dir)
- (dolist (subdir (directory-files dir))
- (unless (equal subdir "..")
- (let ((pkg-dir (expand-file-name subdir dir)))
- (when (file-directory-p pkg-dir)
- (package-load-descriptor pkg-dir))))))))
+ (dolist (pkg-dir (directory-files dir t "\\`[^.]" t))
+ (when (file-directory-p pkg-dir)
+ (package-load-descriptor pkg-dir))))))
(defun package--alist ()
"Return `package-alist', after computing it if needed."
@@ -828,8 +868,7 @@ byte-compilation of the new package to fail."
If DEPS is non-nil, also activate its dependencies (unless they
are already activated).
If RELOAD is non-nil, also `load' any files inside the package which
-correspond to previously loaded files (those returned by
-`package--list-loaded-files')."
+correspond to previously loaded files."
(let* ((name (package-desc-name pkg-desc))
(pkg-dir (package-desc-dir pkg-desc)))
(unless pkg-dir
@@ -867,14 +906,22 @@ correspond to previously loaded files (those returned by
(defun package--get-activatable-pkg (pkg-name)
;; Is "activatable" a word?
- (let ((pkg-descs (cdr (assq pkg-name package-alist))))
+ (let ((pkg-descs (sort (cdr (assq pkg-name package-alist))
+ (lambda (p1 p2)
+ (let ((v1 (package-desc-version p1))
+ (v2 (package-desc-version p2)))
+ (or
+ ;; Prefer source packages.
+ (package-vc-p p1)
+ (package-vc-p p2)
+ ;; Prefer builtin packages.
+ (package-disabled-p p1 v1)
+ (not (package-disabled-p p2 v2))))))))
;; Check if PACKAGE is available in `package-alist'.
(while
(when pkg-descs
(let ((available-version (package-desc-version (car pkg-descs))))
- (or (package-disabled-p pkg-name available-version)
- ;; Prefer a builtin package.
- (package-built-in-p pkg-name available-version))))
+ (package-disabled-p pkg-name available-version)))
(setq pkg-descs (cdr pkg-descs)))
(car pkg-descs)))
@@ -923,7 +970,7 @@ untar into a directory named DIR; otherwise, signal an
error."
(or (string-match regexp name)
;; Tarballs created by some utilities don't list
;; directories with a trailing slash (Bug#13136).
- (and (string-equal dir name)
+ (and (string-equal (expand-file-name dir) name)
(eq (tar-header-link-type tar-data) 5))
(error "Package does not untar cleanly into directory %s/" dir)))))
(tar-untar-buffer))
@@ -952,7 +999,7 @@ untar into a directory named DIR; otherwise, signal an
error."
;; indistinguishable from a `tar' or a `single'. Let's make
;; things simple by ensuring we're one of them.
(setf (package-desc-kind pkg-desc)
- (if (> (length file-list) 1) 'tar 'single))))
+ (if (length> file-list 1) 'tar 'single))))
('tar
(make-directory package-user-dir t)
(let* ((default-directory (file-name-as-directory package-user-dir)))
@@ -1015,6 +1062,7 @@ untar into a directory named DIR; otherwise, signal an
error."
"\n")
nil pkg-file nil 'silent))))
+
;;;; Autoload
(declare-function autoload-rubric "autoload" (file &optional type feature))
@@ -1042,10 +1090,15 @@ untar into a directory named DIR; otherwise, signal an
error."
(backup-inhibited t)
(version-control 'never))
(loaddefs-generate
- pkg-dir output-file
- nil
- "(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))")
+ pkg-dir output-file nil
+ (prin1-to-string
+ '(add-to-list
+ 'load-path
+ ;; Add the directory that will contain the autoload file to
+ ;; the load path. We don't hard-code `pkg-dir', to avoid
+ ;; issues if the package directory is moved around.
+ (or (and load-file-name (file-name-directory load-file-name))
+ (car load-path)))))
(let ((buf (find-buffer-visiting output-file)))
(when buf (kill-buffer buf)))
auto-name))
@@ -1062,11 +1115,13 @@ untar into a directory named DIR; otherwise, signal an
error."
;;;; Compilation
(defvar warning-minimum-level)
+(defvar byte-compile-ignore-files)
(defun package--compile (pkg-desc)
"Byte-compile installed package PKG-DESC.
This assumes that `pkg-desc' has already been activated with
`package-activate-1'."
- (let ((warning-minimum-level :error)
+ (let ((byte-compile-ignore-files (package--parse-elpaignore pkg-desc))
+ (warning-minimum-level :error)
(load-path load-path))
(byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
@@ -1185,8 +1240,12 @@ Return the pkg-desc, with desc-kind set to KIND."
"Find package information for a tar file.
The return result is a `package-desc'."
(cl-assert (derived-mode-p 'tar-mode))
- (let* ((dir-name (file-name-directory
- (tar-header-name (car tar-parse-info))))
+ (let* ((dir-name (named-let loop
+ ((filename (tar-header-name (car tar-parse-info))))
+ (let ((dirname (file-name-directory filename)))
+ ;; The first file can be in a subdir: look for the top.
+ (if dirname (loop (directory-file-name dirname))
+ (file-name-as-directory filename)))))
(desc-file (package--description-file dir-name))
(tar-desc (tar-get-file-descriptor (concat dir-name desc-file))))
(unless tar-desc
@@ -1304,10 +1363,7 @@ is non-nil, don't propagate connection errors (does not
apply to
errors signaled by ERROR-FORM or by BODY).
\(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)"
- (declare (indent defun)
- ;; FIXME: This should be something like
- ;; `form def-body &rest form', but that doesn't work.
- (debug (form &rest sexp)))
+ (declare (indent defun) (debug (sexp body)))
(while (keywordp (car body))
(setq body (cdr (cdr body))))
`(package--with-response-buffer-1 ,url (lambda () ,@body)
@@ -1591,13 +1647,19 @@ This is the value of `package-archive-priorities' last
time
by arbitrary functions to decide whether it is necessary to call
it again.")
+(defvar package-read-archive-hook (list #'package-read-archive-contents)
+ "List of functions to call to read the archive contents.
+Each function must take an optional argument, a symbol indicating
+what archive to read in. The symbol ought to be a key in
+`package-archives'.")
+
(defun package-read-all-archive-contents ()
"Read cached archive file for all archives in `package-archives'.
If successful, set or update `package-archive-contents'."
(setq package-archive-contents nil)
(setq package--old-archive-priorities package-archive-priorities)
(dolist (archive package-archives)
- (package-read-archive-contents (car archive))))
+ (run-hook-with-args 'package-read-archive-hook (car archive))))
;;;; Package Initialize
@@ -1723,9 +1785,14 @@ Once it's empty, run
`package--post-download-archives-hook'."
ARCHIVE should be a cons cell of the form (NAME . LOCATION),
similar to an entry in `package-alist'. Save the cached copy to
\"archives/NAME/FILE\" in `package-user-dir'."
+ ;; The downloaded archive contents will be read as part of
+ ;; `package--update-downloads-in-progress'.
+ (when async
+ (cl-pushnew (cons archive file) package--downloads-in-progress
+ :test #'equal))
(package--with-response-buffer (cdr archive) :file file
:async async
- :error-form (package--update-downloads-in-progress archive)
+ :error-form (package--update-downloads-in-progress (cons archive file))
(let* ((location (cdr archive))
(name (car archive))
(content (buffer-string))
@@ -1738,10 +1805,10 @@ similar to an entry in `package-alist'. Save the
cached copy to
;; If we don't care about the signature, save the file and
;; we're done.
(progn
- (cl-assert (not enable-multibyte-characters))
- (let ((coding-system-for-write 'binary))
- (write-region content nil local-file nil 'silent))
- (package--update-downloads-in-progress archive))
+ (cl-assert (not enable-multibyte-characters))
+ (let ((coding-system-for-write 'binary))
+ (write-region content nil local-file nil 'silent))
+ (package--update-downloads-in-progress (cons archive file)))
;; If we care, check it (perhaps async) and *then* write the file.
(package--check-signature
location file content async
@@ -1754,7 +1821,7 @@ similar to an entry in `package-alist'. Save the cached
copy to
(when good-sigs
(write-region (mapconcat #'epg-signature-to-string good-sigs
"\n")
nil (concat local-file ".signed") nil 'silent)))
- (lambda () (package--update-downloads-in-progress archive))))))))
+ (lambda () (package--update-downloads-in-progress (cons archive
file)))))))))
(defun package--download-and-read-archives (&optional async)
"Download descriptions of all `package-archives' and read them.
@@ -1762,17 +1829,17 @@ Populate `package-archive-contents' with the result.
If optional argument ASYNC is non-nil, perform the downloads
asynchronously."
- ;; The downloaded archive contents will be read as part of
- ;; `package--update-downloads-in-progress'.
- (dolist (archive package-archives)
- (cl-pushnew archive package--downloads-in-progress
- :test #'equal))
(dolist (archive package-archives)
(condition-case-unless-debug nil
(package--download-one-archive archive "archive-contents" async)
(error (message "Failed to download `%s' archive."
(car archive))))))
+(defvar package-refresh-contents-hook (list
#'package--download-and-read-archives)
+ "List of functions to call to refresh the package archive.
+Each function may take an optional argument indicating that the
+operation ought to be executed asynchronously.")
+
;;;###autoload
(defun package-refresh-contents (&optional async)
"Download descriptions of all configured ELPA packages.
@@ -1791,7 +1858,7 @@ downloads in the background."
(condition-case-unless-debug error
(package-import-keyring default-keyring)
(error (message "Cannot import default keyring: %S" (cdr error))))))
- (package--download-and-read-archives async))
+ (run-hook-with-args 'package-refresh-contents-hook async))
;;; Dependency Management
@@ -2025,9 +2092,9 @@ if all the in-between dependencies are also in
PACKAGE-LIST."
(cdr (assoc (package-desc-archive desc) package-archives)))
(defun package-install-from-archive (pkg-desc)
- "Download and install a tar package defined by PKG-DESC."
+ "Download and install a package defined by PKG-DESC."
;; This won't happen, unless the archive is doing something wrong.
- (when (eq (package-desc-kind pkg-desc) 'dir)
+ (when (package-vc-p pkg-desc)
(error "Can't install directory package from archive"))
(let* ((location (package-archive-base pkg-desc))
(file (concat (package-desc-full-name pkg-desc)
@@ -2165,17 +2232,22 @@ to install it but still mark it as selected."
(message "Package `%s' installed." name))
(message "`%s' is already installed" name))))
+(declare-function package-vc-update "package-vc" (pkg))
+
;;;###autoload
(defun package-update (name)
"Update package NAME if a newer version exists."
(interactive
(list (completing-read
"Update package: " (package--updateable-packages) nil t)))
- (let ((package (if (symbolp name)
- name
- (intern name))))
- (package-delete (cadr (assq package package-alist)) 'force)
- (package-install package 'dont-select)))
+ (let* ((package (if (symbolp name)
+ name
+ (intern name)))
+ (pkg-desc (cadr (assq package package-alist))))
+ (if (package-vc-p pkg-desc)
+ (package-vc-update pkg-desc)
+ (package-delete pkg-desc 'force)
+ (package-install package 'dont-select))))
(defun package--updateable-packages ()
;; Initialize the package system to get the list of package
@@ -2185,12 +2257,13 @@ to install it but still mark it as selected."
#'car
(seq-filter
(lambda (elt)
- (let ((available
- (assq (car elt) package-archive-contents)))
- (and available
- (version-list-<
- (package-desc-version (cadr elt))
- (package-desc-version (cadr available))))))
+ (or (let ((available
+ (assq (car elt) package-archive-contents)))
+ (and available
+ (version-list-<
+ (package-desc-version (cadr elt))
+ (package-desc-version (cadr available)))))
+ (package-vc-p (cadr (assq (car elt) package-alist)))))
package-alist)))
;;;###autoload
@@ -2347,15 +2420,19 @@ installed), maybe you need to
\\[package-refresh-contents]")
pkg))
(declare-function comp-el-to-eln-filename "comp.c")
+(defvar package-vc-repository-store)
(defun package--delete-directory (dir)
- "Delete DIR recursively.
+ "Delete PKG-DESC directory DIR recursively.
Clean-up the corresponding .eln files if Emacs is native
compiled."
(when (featurep 'native-compile)
(cl-loop
for file in (directory-files-recursively dir "\\.el\\'")
do (comp-clean-up-stale-eln (comp-el-to-eln-filename file))))
- (delete-directory dir t))
+ (if (file-symlink-p (directory-file-name dir))
+ (delete-file (directory-file-name dir))
+ (delete-directory dir t)))
+
(defun package-delete (pkg-desc &optional force nosave)
"Delete package PKG-DESC.
@@ -2620,7 +2697,10 @@ Helper function for `describe-package'."
(incompatible-reason (package--incompatible-p desc))
(signed (if desc (package-desc-signed desc)))
(maintainer (cdr (assoc :maintainer extras)))
- (authors (cdr (assoc :authors extras))))
+ (authors (cdr (assoc :authors extras)))
+ (news (and-let* ((file (expand-file-name "news" pkg-dir))
+ ((file-readable-p file)))
+ file)))
(when (string= status "avail-obso")
(setq status "available obsolete"))
(when incompatible-reason
@@ -2819,6 +2899,14 @@ Helper function for `describe-package'."
t)
(insert (or readme-string
"This package does not provide a description.")))))
+
+ ;; Insert news if available.
+ (when news
+ (insert "\n" (make-separator-line) "\n"
+ (propertize "* News" 'face 'package-help-section-name)
+ "\n\n")
+ (insert-file-contents news))
+
;; Make library descriptions into links.
(goto-char start-of-description)
(package--describe-add-library-links)
@@ -2909,6 +2997,7 @@ either a full name or nil, and EMAIL is a valid email
address."
"r" #'revert-buffer
"~" #'package-menu-mark-obsolete-for-deletion
"w" #'package-browse-url
+ "b" #'package-report-bug
"x" #'package-menu-execute
"h" #'package-menu-quick-help
"H" #'package-menu-hide-package
@@ -3067,6 +3156,7 @@ of these dependencies, similar to the list returned by
(signed (or (not package-list-unsigned)
(package-desc-signed pkg-desc))))
(cond
+ ((package-vc-p pkg-desc) "source")
((eq dir 'builtin) "built-in")
((and lle (null held)) "disabled")
((stringp held)
@@ -3155,8 +3245,9 @@ to their archives."
(if (not installed)
filtered-by-priority
(let ((ins-version (package-desc-version installed)))
- (cl-remove-if (lambda (p) (version-list-= (package-desc-version
p)
- ins-version))
+ (cl-remove-if (lambda (p) (or (version-list-=
(package-desc-version p)
+ ins-version)
+ (package-vc-p installed)))
filtered-by-priority))))))))
(defcustom package-hidden-regexps nil
@@ -3358,6 +3449,11 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
"Face used on the status and version of installed packages."
:version "25.1")
+(defface package-status-from-source
+ '((t :inherit font-lock-negation-char-face))
+ "Face used on the status and version of installed packages."
+ :version "29.1")
+
(defface package-status-dependency
'((t :inherit package-status-installed))
"Face used on the status and version of dependency packages."
@@ -3395,6 +3491,7 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
("held" 'package-status-held)
("disabled" 'package-status-disabled)
("installed" 'package-status-installed)
+ ("source" 'package-status-from-source)
("dependency" 'package-status-dependency)
("unsigned" 'package-status-unsigned)
("incompat" 'package-status-incompat)
@@ -3406,9 +3503,14 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])."
follow-link t
package-desc ,pkg
action package-menu-describe-package)
- ,(propertize (package-version-join
- (package-desc-version pkg))
- 'font-lock-face face)
+ ,(propertize
+ (if (package-vc-p pkg)
+ (progn
+ (require 'package-vc)
+ (package-vc-commit pkg))
+ (package-version-join
+ (package-desc-version pkg)))
+ 'font-lock-face face)
,(propertize status 'font-lock-face face)
,@(if (cdr package-archives)
(list (propertize (or (package-desc-archive pkg) "")
@@ -3483,7 +3585,7 @@ If optional arg BUTTON is non-nil, describe its
associated package."
(interactive "p" package-menu-mode)
(package--ensure-package-menu-mode)
(if (member (package-menu-get-status)
- '("installed" "dependency" "obsolete" "unsigned"))
+ '("installed" "source" "dependency" "obsolete" "unsigned"))
(tabulated-list-put-tag "D" t)
(forward-line)))
@@ -3839,6 +3941,8 @@ This is used for `tabulated-list-format' in
`package-menu-mode'."
((string= sB "installed") nil)
((string= sA "dependency") t)
((string= sB "dependency") nil)
+ ((string= sA "source") t)
+ ((string= sB "source") nil)
((string= sA "unsigned") t)
((string= sB "unsigned") nil)
((string= sA "held") t)
@@ -4132,6 +4236,7 @@ packages."
"held"
"incompat"
"installed"
+ "source"
"new"
"unsigned")))
package-menu-mode)
@@ -4203,22 +4308,22 @@ Unlike other filters, this leaves the marks intact."
(while (not (eobp))
(setq mark (char-after))
(unless (eq mark ?\s)
- (setq pkg-id (tabulated-list-get-id))
+ (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))
+ (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")))))
+ ;; 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-filter-upgradable ()
"Filter \"*Packages*\" buffer to show only upgradable packages."
@@ -4400,11 +4505,22 @@ beginning of the line."
(package-version-join (package-desc-version package-desc))
(package-desc-summary package-desc))))
+(defun package--query-desc (&optional alist)
+ "Query the user for a package or return the package at point.
+The optional argument ALIST must consist of elements with the
+form (PKG-NAME PKG-DESC). If not specified, it will default to
+`package-alist'."
+ (or (tabulated-list-get-id)
+ (let ((alist (or alist package-alist)))
+ (cadr (assoc (completing-read "Package: " alist nil t)
+ alist #'string=)))))
+
(defun package-browse-url (desc &optional secondary)
"Open the website of the package under point in a browser.
-`browse-url' is used to determine the browser to be used.
-If SECONDARY (interactively, the prefix), use the secondary browser."
- (interactive (list (tabulated-list-get-id)
+`browse-url' is used to determine the browser to be used. If
+SECONDARY (interactively, the prefix), use the secondary browser.
+DESC must be a `package-desc' object."
+ (interactive (list (package--query-desc)
current-prefix-arg)
package-menu-mode)
(unless desc
@@ -4413,9 +4529,56 @@ If SECONDARY (interactively, the prefix), use the
secondary browser."
(unless url
(user-error "No website for %s" (package-desc-name desc)))
(if secondary
- (funcall browse-url-secondary-browser-function url)
+ (funcall browse-url-secondary-browser-function url)
(browse-url url))))
+(declare-function ietf-drums-parse-address "ietf-drums"
+ (string &optional decode))
+
+(defun package-maintainers (pkg-desc &optional no-error)
+ "Return an email address for the maintainers of PKG-DESC.
+The email address may contain commas, if there are multiple
+maintainers. If no maintainers are found, an error will be
+signaled. If the optional argument NO-ERROR is non-nil no error
+will be signaled in that case."
+ (unless (package-desc-p pkg-desc)
+ (error "Invalid package description: %S" pkg-desc))
+ (let* ((name (package-desc-name pkg-desc))
+ (extras (package-desc-extras pkg-desc))
+ (maint (alist-get :maintainer extras)))
+ (cond
+ ((and (null maint) (null no-error))
+ (user-error "Package `%s' has no explicit maintainer" name))
+ ((and (not (progn
+ (require 'ietf-drums)
+ (ietf-drums-parse-address maint)))
+ (null no-error))
+ (user-error "Package `%s' has no maintainer address" name))
+ ((not (null maint))
+ (with-temp-buffer
+ (package--print-email-button maint)
+ (string-trim (substring-no-properties (buffer-string))))))))
+
+(defun package-report-bug (desc)
+ "Prepare a message to send to the maintainers of a package.
+DESC must be a `package-desc' object."
+ (interactive (list (package--query-desc package-alist))
+ package-menu-mode)
+ (let ((maint (package-maintainers desc))
+ (name (symbol-name (package-desc-name desc)))
+ vars)
+ (dolist-with-progress-reporter (group custom-current-group-alist)
+ "Scanning for modified user options..."
+ (dolist (ent (get (cdr group) 'custom-group))
+ (when (and (custom-variable-p (car ent))
+ (boundp (car ent))
+ (not (eq (custom--standard-value (car ent))
+ (default-toplevel-value (car ent))))
+ (file-in-directory-p (car group) (package-desc-dir desc)))
+ (push (car ent) vars))))
+ (dlet ((reporter-prompt-for-summary-p t))
+ (reporter-submit-bug-report maint name vars))))
+
;;;; Introspection
(defun package-get-descriptor (pkg-name)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 897c35b5b1..0f9b60730f 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -211,6 +211,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
(defvar reb-valid-string ""
"String in mode line showing validity of RE.")
+(put 'reb-valid-string 'risky-local-variable t)
(defconst reb-buffer "*RE-Builder*"
"Buffer to use for the RE Builder.")
@@ -308,13 +309,13 @@ Except for Lisp syntax this is the same as `reb-regexp'.")
"Return t if display is capable of displaying colors."
(eq 'color (frame-parameter nil 'display-type)))
-(defsubst reb-lisp-syntax-p ()
+(defun reb-lisp-syntax-p ()
"Return non-nil if RE Builder uses `rx' syntax."
(eq reb-re-syntax 'rx))
-(defmacro reb-target-binding (symbol)
+(defun reb-target-value (symbol)
"Return binding for SYMBOL in the RE Builder target buffer."
- `(with-current-buffer reb-target-buffer ,symbol))
+ (buffer-local-value symbol reb-target-buffer))
(defun reb-initialize-buffer ()
"Initialize the current buffer as a RE Builder buffer."
@@ -440,7 +441,7 @@ provided in the Commentary section of this library."
(interactive)
(reb-update-regexp)
(let ((re (with-output-to-string
- (print (reb-target-binding reb-regexp)))))
+ (print (reb-target-value 'reb-regexp)))))
(setq re (substring re 1 (1- (length re))))
(setq re (string-replace "\n" "\\n" re))
(kill-new re)
@@ -518,12 +519,17 @@ An actual update is only done if the regexp has changed
or if the
optional fourth argument FORCE is non-nil."
(let ((prev-valid reb-valid-string)
(new-valid
- (condition-case nil
+ (condition-case err
(progn
(when (or (reb-update-regexp) force)
(reb-do-update))
"")
- (error " *invalid*"))))
+ (error (propertize
+ (format " %s"
+ (if (and (consp (cdr err)) (stringp (cadr err)))
+ (format "%s: %s" (car err) (cadr err))
+ (car err)))
+ 'face 'font-lock-warning-face)))))
(setq reb-valid-string new-valid)
(force-mode-line-update)
@@ -554,7 +560,7 @@ optional fourth argument FORCE is non-nil."
(if reb-subexp-mode
(format " (subexp %s)" (or reb-subexp-displayed "-"))
"")
- (if (not (reb-target-binding case-fold-search))
+ (if (not (reb-target-value 'case-fold-search))
" Case"
"")))
(force-mode-line-update))
@@ -600,7 +606,7 @@ optional fourth argument FORCE is non-nil."
(defun reb-insert-regexp ()
"Insert current RE."
- (let ((re (or (reb-target-binding reb-regexp)
+ (let ((re (or (reb-target-value 'reb-regexp)
(reb-empty-regexp))))
(cond ((eq reb-re-syntax 'read)
(print re (current-buffer)))
@@ -608,7 +614,7 @@ optional fourth argument FORCE is non-nil."
(insert "\n\"" re "\""))
;; For the Lisp syntax we need the "source" of the regexp
((reb-lisp-syntax-p)
- (insert (or (reb-target-binding reb-regexp-src)
+ (insert (or (reb-target-value 'reb-regexp-src)
(reb-empty-regexp)))))))
(defun reb-cook-regexp (re)
@@ -627,9 +633,8 @@ Return t if the (cooked) expression changed."
(prog1
(not (string= oldre re))
(setq reb-regexp re)
- ;; Only update the source re for the lisp formats
- (when (reb-lisp-syntax-p)
- (setq reb-regexp-src re-src)))))))
+ ;; Update the source re for the Lisp formats.
+ (setq reb-regexp-src re-src))))))
;; And now the real core of the whole thing
@@ -644,7 +649,7 @@ Return t if the (cooked) expression changed."
(defun reb-update-overlays (&optional subexp)
"Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
If SUBEXP is non-nil mark only the corresponding sub-expressions."
- (let* ((re (reb-target-binding reb-regexp))
+ (let* ((re (reb-target-value 'reb-regexp))
(subexps (reb-count-subexps re))
(matches 0)
(submatches 0)
diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el
index dae6590b9b..1083a6868b 100644
--- a/lisp/emacs-lisp/rmc.el
+++ b/lisp/emacs-lisp/rmc.el
@@ -125,7 +125,7 @@
;;;###autoload
(defun read-multiple-choice (prompt choices &optional help-string show-help
long-form)
- "Ask user to select an entry from CHOICES, promting with PROMPT.
+ "Ask user to select an entry from CHOICES, prompting with PROMPT.
This function allows to ask the user a multiple-choice question.
CHOICES should be a list of the form (KEY NAME [DESCRIPTION]).
diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el
index 82ade0ac0c..1645da2eb0 100644
--- a/lisp/emacs-lisp/seq.el
+++ b/lisp/emacs-lisp/seq.el
@@ -63,8 +63,7 @@
;; preloaded. See also Bug#39761#26.
(defmacro seq-doseq (spec &rest body)
- "Loop over a sequence.
-Evaluate BODY with VAR bound to each element of SEQUENCE, in turn.
+ "Loop over a SEQUENCE, evaluating BODY with VAR bound to each of its
elements.
Similar to `dolist' but can be applied to lists, strings, and vectors.
@@ -95,7 +94,7 @@ name to be bound to the rest of SEQUENCE."
,@body))
(defmacro seq-setq (args sequence)
- "Assign to the variables in ARGS the elements of SEQUENCE.
+ "Assign the elements of SEQUENCE to the variables in ARGS.
ARGS can also include the `&rest' marker followed by a variable
name to be bound to the rest of SEQUENCE."
@@ -105,7 +104,7 @@ name to be bound to the rest of SEQUENCE."
;;; Basic seq functions that have to be implemented by new sequence types
(cl-defgeneric seq-elt (sequence n)
- "Return Nth element of SEQUENCE."
+ "Return the Nth element of SEQUENCE."
(elt sequence n))
;; Default gv setters for `seq-elt'.
@@ -118,7 +117,7 @@ name to be bound to the rest of SEQUENCE."
(setcar (nthcdr n sequence) store))
(cl-defgeneric seq-length (sequence)
- "Return the number of elements of SEQUENCE."
+ "Return the number of elements in SEQUENCE."
(length sequence))
(defun seq-first (sequence)
@@ -126,11 +125,12 @@ name to be bound to the rest of SEQUENCE."
(seq-elt sequence 0))
(defun seq-rest (sequence)
- "Return a sequence of the elements of SEQUENCE except the first one."
+ "Return SEQUENCE with its first element removed."
(seq-drop sequence 1))
(cl-defgeneric seq-do (function sequence)
- "Apply FUNCTION to each element of SEQUENCE, presumably for side effects.
+ "Apply FUNCTION to each element of SEQUENCE.
+Presumably, FUNCTION has useful side effects.
Return SEQUENCE."
(mapc function sequence))
@@ -216,8 +216,9 @@ the sequence, and its index within the sequence."
(mapcar function sequence))
(cl-defgeneric seq-mapn (function sequence &rest sequences)
- "Like `seq-map' but FUNCTION is mapped over all SEQUENCES.
-The arity of FUNCTION must match the number of SEQUENCES, and the
+ "Return the result of applying FUNCTION to each element of SEQUENCEs.
+Like `seq-map', but FUNCTION is mapped over all SEQUENCEs.
+The arity of FUNCTION must match the number of SEQUENCEs, and the
mapping stops on the shortest sequence.
Return a list of the results.
@@ -232,7 +233,7 @@ Return a list of the results.
(nreverse result)))
(cl-defgeneric seq-drop (sequence n)
- "Remove the first N elements of SEQUENCE and return the result.
+ "Remove the first N elements of SEQUENCE and return the resulting sequence.
The result is a sequence of the same type as SEQUENCE.
If N is a negative integer or zero, SEQUENCE is returned."
@@ -243,7 +244,7 @@ If N is a negative integer or zero, SEQUENCE is returned."
;;;###autoload
(cl-defgeneric seq-take (sequence n)
- "Take the first N elements of SEQUENCE and return the result.
+ "Return the sequence made of the first N elements of SEQUENCE.
The result is a sequence of the same type as SEQUENCE.
If N is a negative integer or zero, an empty sequence is
@@ -252,14 +253,17 @@ returned."
(cl-defgeneric seq-drop-while (pred sequence)
"Remove the successive elements of SEQUENCE for which PRED returns non-nil.
-PRED is a function of one argument. The result is a sequence of
-the same type as SEQUENCE."
+PRED is a function of one argument. The function keeps removing
+elements from SEQUENCE until PRED returns nil for an element.
+Value is a sequence of the same type as SEQUENCE."
(seq-drop sequence (seq--count-successive pred sequence)))
(cl-defgeneric seq-take-while (pred sequence)
"Take the successive elements of SEQUENCE for which PRED returns non-nil.
-PRED is a function of one argument. The result is a sequence of
-the same type as SEQUENCE."
+PRED is a function of one argument. The function keeps collecting
+elements from SEQUENCE and adding them to the result until PRED
+returns nil for an element.
+Value is a sequence of the same type as SEQUENCE."
(seq-take sequence (seq--count-successive pred sequence)))
(cl-defgeneric seq-empty-p (sequence)
@@ -267,7 +271,7 @@ the same type as SEQUENCE."
(= 0 (seq-length sequence)))
(cl-defgeneric seq-sort (pred sequence)
- "Sort SEQUENCE using PRED as comparison function.
+ "Sort SEQUENCE using PRED as the sorting comparison function.
The result is a sequence of the same type as SEQUENCE."
(let ((result (seq-sort pred (append sequence nil))))
(seq-into result (type-of sequence))))
@@ -277,7 +281,7 @@ The result is a sequence of the same type as SEQUENCE."
;;;###autoload
(defun seq-sort-by (function pred sequence)
- "Sort SEQUENCE using PRED as a comparison function.
+ "Sort SEQUENCE transformed by FUNCTION using PRED as the comparison function.
Elements of SEQUENCE are transformed by FUNCTION before being
sorted. FUNCTION must be a function of one argument."
(seq-sort (lambda (a b)
@@ -300,7 +304,7 @@ sorted. FUNCTION must be a function of one argument."
(cl-defgeneric seq-concatenate (type &rest sequences)
"Concatenate SEQUENCES into a single sequence of type TYPE.
-TYPE must be one of following symbols: vector, string or list.
+TYPE must be one of following symbols: `vector', `string' or `list'.
\n(fn TYPE SEQUENCE...)"
(setq sequences (mapcar #'seq-into-sequence sequences))
@@ -322,8 +326,8 @@ of sequence."
(cl-defgeneric seq-into (sequence type)
"Concatenate the elements of SEQUENCE into a sequence of type TYPE.
-TYPE can be one of the following symbols: vector, string or
-list."
+TYPE can be one of the following symbols: `vector', `string' or
+`list'."
(pcase type
(`vector (seq--into-vector sequence))
(`string (seq--into-string sequence))
@@ -332,7 +336,7 @@ list."
;;;###autoload
(cl-defgeneric seq-filter (pred sequence)
- "Return a list of all elements for which (PRED element) is non-nil in
SEQUENCE."
+ "Return a list of all the elements in SEQUENCE for which PRED returns
non-nil."
(let ((exclude (make-symbol "exclude")))
(delq exclude (seq-map (lambda (elt)
(if (funcall pred elt)
@@ -342,13 +346,13 @@ list."
;;;###autoload
(cl-defgeneric seq-remove (pred sequence)
- "Return a list of all the elements for which (PRED element) is nil in
SEQUENCE."
+ "Return a list of all the elements in SEQUENCE for which PRED returns nil."
(seq-filter (lambda (elt) (not (funcall pred elt)))
sequence))
;;;###autoload
(cl-defgeneric seq-remove-at-position (sequence n)
- "Return a copy of SEQUENCE where the element at N got removed.
+ "Return a copy of SEQUENCE with the element at index N removed.
N is the (zero-based) index of the element that should not be in
the result.
@@ -381,7 +385,7 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is
not called."
;;;###autoload
(cl-defgeneric seq-every-p (pred sequence)
- "Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE."
+ "Return non-nil if PRED returns non-nil for all the elements of SEQUENCE."
(catch 'seq--break
(seq-doseq (elt sequence)
(or (funcall pred elt)
@@ -390,8 +394,8 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is
not called."
;;;###autoload
(cl-defgeneric seq-some (pred sequence)
- "Return non-nil if PRED is satisfied for at least one element of SEQUENCE.
-If so, return the first non-nil value returned by PRED."
+ "Return non-nil if PRED returns non-nil for at least one element of SEQUENCE.
+If the value is non-nil, it is the first non-nil value returned by PRED."
(catch 'seq--break
(seq-doseq (elt sequence)
(let ((result (funcall pred elt)))
@@ -401,12 +405,12 @@ If so, return the first non-nil value returned by PRED."
;;;###autoload
(cl-defgeneric seq-find (pred sequence &optional default)
- "Return the first element for which (PRED element) is non-nil in SEQUENCE.
-If no element is found, return DEFAULT.
+ "Return the first element in SEQUENCE for which PRED returns non-nil.
+If no such element is found, return DEFAULT.
Note that `seq-find' has an ambiguity if the found element is
-identical to DEFAULT, as it cannot be known if an element was
-found or not."
+identical to DEFAULT, as in that case it is impossible to know
+whether an element was found or not."
(catch 'seq--break
(seq-doseq (elt sequence)
(when (funcall pred elt)
@@ -414,7 +418,7 @@ found or not."
default))
(cl-defgeneric seq-count (pred sequence)
- "Return the number of elements for which (PRED element) is non-nil in
SEQUENCE."
+ "Return the number of elements in SEQUENCE for which PRED returns non-nil."
(let ((count 0))
(seq-doseq (elt sequence)
(when (funcall pred elt)
@@ -422,8 +426,8 @@ found or not."
count))
(cl-defgeneric seq-contains (sequence elt &optional testfn)
- "Return the first element in SEQUENCE that is equal to ELT.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return the first element in SEQUENCE that is \"equal\" to ELT.
+\"Equality\" is defined by the function TESTFN, which defaults to `equal'."
(declare (obsolete seq-contains-p "27.1"))
(seq-some (lambda (e)
(when (funcall (or testfn #'equal) elt e)
@@ -431,8 +435,8 @@ Equality is defined by the function TESTFN, which defaults
to `equal'."
sequence))
(cl-defgeneric seq-contains-p (sequence elt &optional testfn)
- "Return non-nil if SEQUENCE contains an element equal to ELT.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return non-nil if SEQUENCE contains an element \"equal\" to ELT.
+\"Equality\" is defined by the function TESTFN, which defaults to `equal'."
(catch 'seq--break
(seq-doseq (e sequence)
(let ((r (funcall (or testfn #'equal) e elt)))
@@ -442,15 +446,16 @@ Equality is defined by the function TESTFN, which
defaults to `equal'."
(cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn)
"Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements.
-This does not depend on the order of the elements.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+The order of the elements in the sequences is not important.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(and (seq-every-p (lambda (item1) (seq-contains-p sequence2 item1 testfn))
sequence1)
(seq-every-p (lambda (item2) (seq-contains-p sequence1 item2 testfn))
sequence2)))
;;;###autoload
(cl-defgeneric seq-position (sequence elt &optional testfn)
- "Return the (zero-based) index of the first element in SEQUENCE equal to ELT.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return the (zero-based) index of the first element in SEQUENCE \"equal\" to
ELT.
+\"Equality\" is defined by the function TESTFN, which defaults to `equal'."
(let ((index 0))
(catch 'seq--break
(seq-doseq (e sequence)
@@ -461,11 +466,11 @@ Equality is defined by the function TESTFN, which
defaults to `equal'."
;;;###autoload
(cl-defgeneric seq-positions (sequence elt &optional testfn)
- "Return indices for which (TESTFN (seq-elt SEQUENCE index) ELT) is non-nil.
+ "Return list of indices of SEQUENCE elements for which TESTFN returns
non-nil.
-TESTFN is a two-argument function which is passed each element of
-SEQUENCE as first argument and ELT as second. TESTFN defaults to
-`equal'.
+TESTFN is a two-argument function which is called with each element of
+SEQUENCE as the first argument and ELT as the second.
+TESTFN defaults to `equal'.
The result is a list of (zero-based) indices."
(let ((result '()))
@@ -479,7 +484,7 @@ The result is a list of (zero-based) indices."
;;;###autoload
(cl-defgeneric seq-uniq (sequence &optional testfn)
"Return a list of the elements of SEQUENCE with duplicates removed.
-TESTFN is used to compare elements, or `equal' if TESTFN is nil."
+TESTFN is used to compare elements, and defaults to `equal'."
(let ((result '()))
(seq-doseq (elt sequence)
(unless (seq-contains-p result elt testfn)
@@ -514,15 +519,15 @@ TESTFN is used to compare elements, or `equal' if TESTFN
is nil."
(nreverse result)))
(cl-defgeneric seq-mapcat (function sequence &optional type)
- "Concatenate the result of applying FUNCTION to each element of SEQUENCE.
-The result is a sequence of type TYPE, or a list if TYPE is nil."
+ "Concatenate the results of applying FUNCTION to each element of SEQUENCE.
+The result is a sequence of type TYPE; TYPE defaults to `list'."
(apply #'seq-concatenate (or type 'list)
(seq-map function sequence)))
(cl-defgeneric seq-partition (sequence n)
"Return list of elements of SEQUENCE grouped into sub-sequences of length N.
The last sequence may contain less than N elements. If N is a
-negative integer or 0, nil is returned."
+negative integer or 0, the function returns nil."
(unless (< n 1)
(let ((result '()))
(while (not (seq-empty-p sequence))
@@ -532,8 +537,9 @@ negative integer or 0, nil is returned."
;;;###autoload
(cl-defgeneric seq-union (sequence1 sequence2 &optional testfn)
- "Return a list of all elements that appear in either SEQUENCE1 or SEQUENCE2.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return a list of all the elements that appear in either SEQUENCE1 or
SEQUENCE2.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(let* ((accum (lambda (acc elt)
(if (seq-contains-p acc elt testfn)
acc
@@ -544,8 +550,9 @@ Equality is defined by the function TESTFN, which defaults
to `equal'."
;;;###autoload
(cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn)
- "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return a list of all the elements that appear in both SEQUENCE1 and
SEQUENCE2.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(seq-reduce (lambda (acc elt)
(if (seq-contains-p sequence2 elt testfn)
(cons elt acc)
@@ -554,8 +561,9 @@ Equality is defined by the function TESTFN, which defaults
to `equal'."
'()))
(cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn)
- "Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2.
-Equality is defined by the function TESTFN, which defaults to `equal'."
+ "Return list of all the elements that appear in SEQUENCE1 but not in
SEQUENCE2.
+\"Equality\" of elements is defined by the function TESTFN, which
+defaults to `equal'."
(seq-reduce (lambda (acc elt)
(if (seq-contains-p sequence2 elt testfn)
acc
@@ -591,7 +599,7 @@ SEQUENCE must be a sequence of numbers or markers."
(apply #'max (seq-into sequence 'list)))
(defun seq--count-successive (pred sequence)
- "Count successive elements for which (PRED element) is non-nil in SEQUENCE."
+ "Count successive elements in SEQUENCE for which PRED returns non-nil."
(let ((n 0)
(len (seq-length sequence)))
(while (and (< n len)
@@ -628,13 +636,13 @@ SEQUENCE must be a sequence of numbers or markers."
;; TODO: make public?
(defun seq--elt-safe (sequence n)
- "Return element of SEQUENCE at the index N.
+ "Return the element of SEQUENCE whose zero-based index is N.
If no element is found, return nil."
(ignore-errors (seq-elt sequence n)))
;;;###autoload
(cl-defgeneric seq-random-elt (sequence)
- "Return a random element from SEQUENCE.
+ "Return a randomly chosen element from SEQUENCE.
Signal an error if SEQUENCE is empty."
(if (seq-empty-p sequence)
(error "Sequence cannot be empty")
@@ -681,8 +689,8 @@ Signal an error if SEQUENCE is empty."
(concat sequence)))
(defun seq-split (sequence length)
- "Split SEQUENCE into a list of sub-sequences of at most LENGTH.
-All the sub-sequences will be of LENGTH, except the last one,
+ "Split SEQUENCE into a list of sub-sequences of at most LENGTH elements.
+All the sub-sequences will be LENGTH long, except the last one,
which may be shorter."
(when (< length 1)
(error "Sub-sequence length must be larger than zero"))
@@ -696,7 +704,7 @@ which may be shorter."
(nreverse result)))
(defun seq-keep (function sequence)
- "Apply FUNCTION to SEQUENCE and return all non-nil results."
+ "Apply FUNCTION to SEQUENCE and return the list of all the non-nil results."
(delq nil (seq-map function sequence)))
(provide 'seq)
diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el
index 4cfd658e10..8328324715 100644
--- a/lisp/emacs-lisp/shortdoc.el
+++ b/lisp/emacs-lisp/shortdoc.el
@@ -833,7 +833,7 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
(seq-set-equal-p
:eval (seq-set-equal-p '(1 2 3) '(3 1 2)))
(seq-some
- :eval (seq-some #'cl-evenp '(1 2 3)))
+ :eval (seq-some #'floatp '(1 2.0 3)))
"Building Sequences"
(seq-concatenate
:eval (seq-concatenate 'vector '(1 2) '(c d)))
@@ -897,13 +897,15 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
:eval (seq-drop-while #'numberp '(1 2 c d 5)))
(seq-filter
:eval (seq-filter #'numberp '(a b 3 4 f 6)))
+ (seq-keep
+ :eval (seq-keep #'car-safe '((1 2) 3 t (a . b))))
(seq-remove
:eval (seq-remove #'numberp '(1 2 c d 5)))
(seq-remove-at-position
:eval (seq-remove-at-position '(a b c d e) 3)
:eval (seq-remove-at-position [a b c d e] 0))
(seq-group-by
- :eval (seq-group-by #'cl-plusp '(-1 2 3 -4 -5 6)))
+ :eval (seq-group-by #'natnump '(-1 2 3 -4 -5 6)))
(seq-union
:eval (seq-union '(1 2 3) '(3 5)))
(seq-difference
@@ -919,7 +921,7 @@ A FUNC form can have any number of `:no-eval' (or
`:no-value'),
(seq-split
:eval (seq-split [0 1 2 3 5] 2))
(seq-take-while
- :eval (seq-take-while #'cl-evenp [2 4 9 6 5]))
+ :eval (seq-take-while #'integerp [1 2 3.0 4]))
(seq-uniq
:eval (seq-uniq '(a b d b a c))))
@@ -1372,13 +1374,20 @@ If SAME-WINDOW, don't pop to a new window."
(unless (bobp)
(insert "\n"))
(insert (propertize
- (concat (substitute-command-keys data) "\n\n")
+ (substitute-command-keys data)
+ 'face 'shortdoc-heading
+ 'shortdoc-section t
+ 'outline-level 1))
+ (insert (propertize
+ "\n\n"
'face 'shortdoc-heading
'shortdoc-section t)))
;; There may be functions not yet defined in the data.
((fboundp (car data))
(when prev
- (insert (make-separator-line)))
+ (insert (make-separator-line)
+ ;; This helps with hidden outlines (bug#53981)
+ (propertize "\n" 'face '(:height 0))))
(setq prev t)
(shortdoc--display-function data))))
(cdr (assq group shortdoc--groups))))
@@ -1395,7 +1404,7 @@ If SAME-WINDOW, don't pop to a new window."
(start-section (point))
arglist-start)
;; Function calling convention.
- (insert (propertize "(" 'shortdoc-function function))
+ (insert (propertize "(" 'shortdoc-function function 'outline-level 2))
(if (plist-get data :no-manual)
(insert-text-button
(symbol-name function)
@@ -1529,7 +1538,10 @@ Example:
(define-derived-mode shortdoc-mode special-mode "shortdoc"
"Mode for shortdoc."
- :interactive nil)
+ :interactive nil
+ (setq-local outline-search-function #'outline-search-level
+ outline-level (lambda ()
+ (get-text-property (point) 'outline-level))))
(defun shortdoc--goto-section (arg sym &optional reverse)
(unless (natnump arg)
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index 61d52026b3..b86070deef 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -56,7 +56,7 @@
;; which includes a kind of tutorial to get started with SMIE:
;;
;; SMIE: Weakness is Power! Auto-indentation with incomplete information
-;; Stefan Monnier, <Programming> Journal 2020, volumn 5, issue 1.
+;; Stefan Monnier, <Programming> Journal 2020, volume 5, issue 1.
;; doi: 10.22152/programming-journal.org/2021/5/1
;; A good background to understand the development (especially the parts
diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el
index 6e4d88b4df..18087bc937 100644
--- a/lisp/emacs-lisp/subr-x.el
+++ b/lisp/emacs-lisp/subr-x.el
@@ -322,6 +322,10 @@ as the new values of the bound variables in the recursive
invocation."
;; Keeping a work buffer around is more efficient than creating a
;; new temporary buffer.
(with-current-buffer (get-buffer-create " *string-pixel-width*")
+ ;; `display-line-numbers-mode' is enabled in internal buffers
+ ;; that breaks width calculation, so need to disable (bug#59311)
+ (when (bound-and-true-p display-line-numbers-mode)
+ (display-line-numbers-mode -1))
(delete-region (point-min) (point-max))
(insert string)
(car (buffer-text-pixel-size nil nil t)))))
diff --git a/lisp/emacs-lisp/tabulated-list.el
b/lisp/emacs-lisp/tabulated-list.el
index c01f3fd4fe..206c10a773 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -374,7 +374,7 @@ Optional arg POS is a buffer position where to look for a
fake header;
defaults to `point-min'."
(overlays-at (or pos (point-min))))
-(defun tabulated-list-revert (&rest ignored)
+(defun tabulated-list-revert (&rest _ignored)
"The `revert-buffer-function' for `tabulated-list-mode'.
It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
(interactive)
diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el
index 2b1672ffd6..645b1a328f 100644
--- a/lisp/emacs-lisp/tcover-ses.el
+++ b/lisp/emacs-lisp/tcover-ses.el
@@ -569,7 +569,7 @@ spreadsheet files with invalid formatting."
(signal 'singularity-error nil)) ;Shouldn't get here
(singularity-error (error "No error from %s?" x))
(error nil)))
- ;;Test quit-handling in ses-update-cells. Cant' use `eval' here.
+ ;; Test quit-handling in ses-update-cells. Can't use `eval' here.
(let ((inhibit-quit t))
(setq quit-flag t)
(condition-case nil
diff --git a/lisp/emacs-lisp/text-property-search.el
b/lisp/emacs-lisp/text-property-search.el
index d11980f4f4..d41222bdbf 100644
--- a/lisp/emacs-lisp/text-property-search.el
+++ b/lisp/emacs-lisp/text-property-search.el
@@ -208,8 +208,14 @@ and if a matching region is found, place point at the
start of the region."
(goto-char end)
(setq ended t)))))
;; End this at the first place the property changes value.
- (setq end (previous-single-property-change
- (point) property nil (point-min)))
+ (setq end
+ (if (and (> (point) (point-min))
+ (text-property--match-p
+ value (get-text-property (1- (point)) property)
+ predicate))
+ (previous-single-property-change (point)
+ property nil (point-min))
+ (point)))
(goto-char end))
(make-prop-match :beginning end
:end (1+ start)
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el
index 9bdf90bf1d..de8503a1cb 100644
--- a/lisp/emacs-lisp/vtable.el
+++ b/lisp/emacs-lisp/vtable.el
@@ -353,6 +353,11 @@ This also updates the displayed table."
(let* ((cache (vtable--cache table))
(inhibit-read-only t)
(keymap (get-text-property (point) 'keymap))
+ (ellipsis (if (vtable-ellipsis table)
+ (propertize (truncate-string-ellipsis)
+ 'face (vtable-face table))
+ ""))
+ (ellipsis-width (string-pixel-width ellipsis))
(elem (and after-object
(assq after-object (car cache))))
(line (cons object (vtable--compute-cached-line table object))))
@@ -370,7 +375,8 @@ This also updates the displayed table."
;; FIXME: We have to adjust colors in lines below this if we
;; have :row-colors.
(vtable--insert-line table line 0
- (nth 1 cache) (vtable--spacer table))
+ (nth 1 cache) (vtable--spacer table)
+ ellipsis ellipsis-width)
(add-text-properties start (point) (list 'keymap keymap
'vtable table)))
;; We may have inserted a non-numerical value into a previously
@@ -516,7 +522,8 @@ This also updates the displayed table."
(if (> (nth 1 elem) (elt widths index))
(concat
(vtable--limit-string
- pre-computed (- (elt widths index) ellipsis-width))
+ pre-computed (- (elt widths index)
+ (or ellipsis-width 0)))
ellipsis)
pre-computed))
;; Recompute widths.
@@ -524,7 +531,8 @@ This also updates the displayed table."
(if (> (string-pixel-width value) (elt widths index))
(concat
(vtable--limit-string
- value (- (elt widths index) ellipsis-width))
+ value (- (elt widths index)
+ (or ellipsis-width 0)))
ellipsis)
value))))
(start (point))
diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1
index 0ea7ef09aa..64231f365e 100644
--- a/lisp/erc/ChangeLog.1
+++ b/lisp/erc/ChangeLog.1
@@ -3779,7 +3779,7 @@
doesn't appear).
* NEWS: Added the information from
- http://emacswiki.org/cgi-bin/wiki/ErcCvsFeatures and the newer
+ https://emacswiki.org/cgi-bin/wiki/ErcCvsFeatures and the newer
changes which weren't yet documented on that page.
2005-01-06 Hoan Ton-That <hoan@ton-that.org>
@@ -8298,7 +8298,7 @@
it doesn't move point to end-of-buffer in non-ERC buffers. Fixed
erc-kill-buffer-function so it doesn't run the erc-kill-server-hook
hooks if the
server connection is closed. Fixed bug 658552, which is described in
detail at
-
http://sourceforge.net/tracker/index.php?func=detail&aid=658552&group_id=30118&atid=398125
+
https://sourceforge.net/tracker/index.php?func=detail&aid=658552&group_id=30118&atid=398125
2002-12-26 Alex Schroeder <alex@gnu.org>
@@ -9372,8 +9372,8 @@
2002-08-14 Mario Lang <mlang@delysid.org>
- * erc-button.el:
- Try to be compatible to XEmacs regexp-opt. (Im going to quit this job
if I find more of those damn differencies
+ * erc-button.el: Try to be compatible to XEmacs regexp-opt. (I'm
+ going to quit this job if I find more of those damn differences.)
* debian/README.Debian, debian/scripts/install:
* Added info to README.Debian
@@ -11075,7 +11075,8 @@
stay at your current version. It seems fairly stable though.
That changed? erc-buffer-name handling was completely rewritten,
and erc-buffer-list local variable handling removed.
- Simplifies alot of code. Poke at it. read the diff. report bug/send
patches!
+ Simplifies a lot of code. Poke at it. Read the diff. Report
+ bug/send patches!
* erc.el: * Added variable listing when /set is used without args
@@ -11448,7 +11449,7 @@
2001-10-03 Mario Lang <mlang@delysid.org>
* erc.el:
- * Removed alot of (progn ...) where they were not necessary
+ * Removed a lot of (progn ...) where they were not necessary
* Changed some (if ...) without else part to (when ...)
* Some (while ...) to use (dolist ...)
* Fix for completion popup generating tracebacks.
diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el
index df9efe4b0c..15fd6ac50f 100644
--- a/lisp/erc/erc-backend.el
+++ b/lisp/erc/erc-backend.el
@@ -99,24 +99,117 @@
;;; Code:
(eval-when-compile (require 'cl-lib))
-;; There's a fairly strong mutual dependency between erc.el and erc-backend.el.
-;; Luckily, erc.el does not need erc-backend.el for macroexpansion whereas the
-;; reverse is true:
-(require 'erc)
+(require 'erc-common)
+
+(defvar erc--target)
+(defvar erc-auto-query)
+(defvar erc-channel-list)
+(defvar erc-channel-users)
+(defvar erc-default-nicks)
+(defvar erc-default-recipients)
+(defvar erc-format-nick-function)
+(defvar erc-format-query-as-channel-p)
+(defvar erc-hide-prompt)
+(defvar erc-input-marker)
+(defvar erc-insert-marker)
+(defvar erc-invitation)
+(defvar erc-join-buffer)
+(defvar erc-kill-buffer-on-part)
+(defvar erc-kill-server-buffer-on-quit)
+(defvar erc-log-p)
+(defvar erc-minibuffer-ignored)
+(defvar erc-networks--id)
+(defvar erc-nick)
+(defvar erc-nick-change-attempt-count)
+(defvar erc-prompt-for-channel-key)
+(defvar erc-prompt-hidden)
+(defvar erc-reuse-buffers)
+(defvar erc-verbose-server-ping)
+(defvar erc-whowas-on-nosuchnick)
+
+(declare-function erc--open-target "erc" (target))
+(declare-function erc--target-from-string "erc" (string))
+(declare-function erc-active-buffer "erc" nil)
+(declare-function erc-add-default-channel "erc" (channel))
+(declare-function erc-banlist-update "erc" (proc parsed))
+(declare-function erc-buffer-filter "erc" (predicate &optional proc))
+(declare-function erc-buffer-list-with-nick "erc" (nick proc))
+(declare-function erc-channel-begin-receiving-names "erc" nil)
+(declare-function erc-channel-end-receiving-names "erc" nil)
+(declare-function erc-channel-p "erc" (channel))
+(declare-function erc-channel-receive-names "erc" (names-string))
+(declare-function erc-cmd-JOIN "erc" (channel &optional key))
+(declare-function erc-connection-established "erc" (proc parsed))
+(declare-function erc-current-nick "erc" nil)
+(declare-function erc-current-nick-p "erc" (nick))
+(declare-function erc-current-time "erc" (&optional specified-time))
+(declare-function erc-default-target "erc" nil)
+(declare-function erc-delete-default-channel "erc" (channel &optional buffer))
+(declare-function erc-display-error-notice "erc" (parsed string))
+(declare-function erc-display-server-message "erc" (_proc parsed))
+(declare-function erc-emacs-time-to-erc-time "erc" (&optional specified-time))
+(declare-function erc-format-message "erc" (msg &rest args))
+(declare-function erc-format-privmessage "erc" (nick msg privp msgp))
+(declare-function erc-get-buffer "erc" (target &optional proc))
+(declare-function erc-handle-login "erc" nil)
+(declare-function erc-handle-user-status-change "erc" (type nlh &optional l))
+(declare-function erc-ignored-reply-p "erc" (msg tgt proc))
+(declare-function erc-ignored-user-p "erc" (spec))
+(declare-function erc-is-message-ctcp-and-not-action-p "erc" (message))
+(declare-function erc-is-message-ctcp-p "erc" (message))
+(declare-function erc-log-irc-protocol "erc" (string &optional outbound))
+(declare-function erc-login "erc" nil)
+(declare-function erc-make-notice "erc" (message))
+(declare-function erc-network "erc-networks" nil)
+(declare-function erc-networks--id-given "erc-networks" (arg &rest args))
+(declare-function erc-networks--id-reload "erc-networks" (arg &rest args))
+(declare-function erc-nickname-in-use "erc" (nick reason))
+(declare-function erc-parse-user "erc" (string))
+(declare-function erc-process-away "erc" (proc away-p))
+(declare-function erc-process-ctcp-query "erc" (proc parsed nick login host))
+(declare-function erc-query-buffer-p "erc" (&optional buffer))
+(declare-function erc-remove-channel-member "erc" (channel nick))
+(declare-function erc-remove-channel-users "erc" nil)
+(declare-function erc-remove-user "erc" (nick))
+(declare-function erc-sec-to-time "erc" (ns))
+(declare-function erc-server-buffer "erc" nil)
+(declare-function erc-set-active-buffer "erc" (buffer))
+(declare-function erc-set-current-nick "erc" (nick))
+(declare-function erc-set-modes "erc" (tgt mode-string))
+(declare-function erc-time-diff "erc" (t1 t2))
+(declare-function erc-trim-string "erc" (s))
+(declare-function erc-update-mode-line "erc" (&optional buffer))
+(declare-function erc-update-mode-line-buffer "erc" (buffer))
+(declare-function erc-wash-quit-reason "erc" (reason nick login host))
+
+(declare-function erc-display-message "erc"
+ (parsed type buffer msg &rest args))
+(declare-function erc-get-buffer-create "erc"
+ (server port target &optional tgt-info id))
+(declare-function erc-process-ctcp-reply "erc"
+ (proc parsed nick login host msg))
+(declare-function erc-update-channel-topic "erc"
+ (channel topic &optional modify))
+(declare-function erc-update-modes "erc"
+ (tgt mode-string &optional _nick _host _login))
+(declare-function erc-update-user-nick "erc"
+ (nick &optional new-nick host login full-name info))
+(declare-function erc-open "erc"
+ (&optional server port nick full-name connect passwd tgt-list
+ channel process client-certificate user id))
+(declare-function erc-update-channel-member "erc"
+ (channel nick new-nick
+ &optional add voice halfop op admin owner host
+ login full-name info update-message-time))
;;;; Variables and options
+(defvar-local erc-session-password nil
+ "The password used for the current session.")
+
(defvar erc-server-responses (make-hash-table :test #'equal)
"Hash table mapping server responses to their handler hooks.")
-(cl-defstruct (erc-response (:conc-name erc-response.))
- (unparsed "" :type string)
- (sender "" :type string)
- (command "" :type string)
- (command-args '() :type list)
- (contents "" :type string)
- (tags '() :type list))
-
;;; User data
(defvar-local erc-server-current-nick nil
@@ -206,6 +299,9 @@ function `erc-server-process-alive' instead.")
(defvar-local erc--server-last-reconnect-count 0
"Snapshot of reconnect count when the connection was established.")
+(defvar-local erc--server-reconnect-timer nil
+ "Auto-reconnect timer for a network context.")
+
(defvar-local erc-server-quitting nil
"Non-nil if the user requests a quit.")
@@ -308,6 +404,16 @@ This only has an effect if `erc-server-auto-reconnect' is
non-nil."
If a key is pressed while ERC is waiting, it will stop waiting."
:type 'number)
+(defcustom erc-server-reconnect-function 'erc-server-delayed-reconnect
+ "Function called by the reconnect timer to create a new connection.
+Called with a server buffer as its only argument. Potential uses
+include exponential backoff and probing for connectivity prior to
+dialing. Use `erc-schedule-reconnect' to instead try again later
+and optionally alter the attempts tally."
+ :package-version '(ERC . "5.4.1") ; FIXME on next release
+ :type '(choice (function-item erc-server-delayed-reconnect)
+ function))
+
(defcustom erc-split-line-length 440
"The maximum length of a single message.
If a message exceeds this size, it is broken into multiple ones.
@@ -532,12 +638,18 @@ The current buffer is given by BUFFER."
(let ((p (plist-put parameters :nowait t)))
(apply #'open-network-stream name buffer host service p)))
+(defvar erc--server-connect-dumb-ipv6-regexp
+ ;; Not for validation (gives false positives).
+ (rx bot "[" (group (+ (any xdigit digit ":.")) (? "%" (+ alnum))) "]" eot))
+
(defun erc-server-connect (server port buffer &optional client-certificate)
"Perform the connection and login using the specified SERVER and PORT.
We will store server variables in the buffer given by BUFFER.
CLIENT-CERTIFICATE may optionally be used to specify a TLS client
certificate to use for authentication when connecting over
TLS (see `erc-session-client-certificate' for more details)."
+ (when (string-match erc--server-connect-dumb-ipv6-regexp server)
+ (setq server (match-string 1 server)))
(let ((msg (erc-format-message 'connect ?S server ?p port)) process
(args `(,(format "erc-%s-%s" server port) nil ,server ,port)))
(when client-certificate
@@ -552,7 +664,8 @@ TLS (see `erc-session-client-certificate' for more
details)."
(setq erc-server-process process)
(setq erc-server-quitting nil)
(setq erc-server-reconnecting nil
- erc--server-reconnecting nil)
+ erc--server-reconnecting nil
+ erc--server-reconnect-timer nil)
(setq erc-server-timed-out nil)
(setq erc-server-banned nil)
(setq erc-server-error-occurred nil)
@@ -593,6 +706,7 @@ Make sure you are in an ERC buffer when running this."
(with-current-buffer buffer
(erc-update-mode-line)
(erc-set-active-buffer (current-buffer))
+ (setq erc--server-reconnecting t)
(setq erc-server-last-sent-time 0)
(setq erc-server-lines-sent 0)
(let ((erc-server-connect-function (or erc-session-connector
@@ -665,37 +779,59 @@ EVENT is the message received from the closed connection
process."
erc-server-reconnecting)
(erc--server-reconnect-p event)))
+(defconst erc--mode-line-process-reconnecting
+ '(:eval (erc-with-server-buffer
+ (and erc--server-reconnect-timer
+ (format ": reconnecting in %.1fs"
+ (- (timer-until erc--server-reconnect-timer
+ (current-time)))))))
+ "Mode-line construct showing seconds until next reconnect attempt.
+Move point around to refresh.")
+
+(defun erc--cancel-auto-reconnect-timer ()
+ (when erc--server-reconnect-timer
+ (cancel-timer erc--server-reconnect-timer)
+ (erc-display-message nil 'notice nil 'reconnect-canceled
+ ?u (buffer-name)
+ ?c (- (timer-until erc--server-reconnect-timer
+ (current-time))))
+ (setq erc--server-reconnect-timer nil)
+ (erc-update-mode-line)))
+
+(defun erc-schedule-reconnect (buffer &optional incr)
+ "Create and return a reconnect timer for BUFFER.
+When `erc-server-reconnect-attempts' is a number, increment
+`erc-server-reconnect-count' by INCR unconditionally."
+ (let ((count (and (integerp erc-server-reconnect-attempts)
+ (- erc-server-reconnect-attempts
+ (cl-incf erc-server-reconnect-count (or incr 1))))))
+ (erc-display-message nil 'error (current-buffer) 'reconnecting
+ ?m erc-server-reconnect-timeout
+ ?i (if count erc-server-reconnect-count "N")
+ ?n (if count erc-server-reconnect-attempts "A"))
+ (setq erc-server-reconnecting nil
+ erc--server-reconnect-timer
+ (run-at-time erc-server-reconnect-timeout nil
+ erc-server-reconnect-function buffer))))
+
(defun erc-process-sentinel-2 (event buffer)
"Called when `erc-process-sentinel-1' has detected an unexpected disconnect."
- (if (not (buffer-live-p buffer))
- (erc-update-mode-line)
+ (when (buffer-live-p buffer)
(with-current-buffer buffer
- (let ((reconnect-p (erc--server-reconnect-p event)) message delay)
+ (let ((reconnect-p (erc--server-reconnect-p event)) message)
(setq message (if reconnect-p 'disconnected 'disconnected-noreconnect))
(erc-display-message nil 'error (current-buffer) message)
(if (not reconnect-p)
;; terminate, do not reconnect
(progn
- (setq erc--server-reconnecting nil)
+ (setq erc--server-reconnecting nil
+ erc--server-reconnect-timer nil)
(erc-display-message nil 'error (current-buffer)
'terminated ?e event)
- ;; Update mode line indicators
- (erc-update-mode-line)
(set-buffer-modified-p nil))
;; reconnect
- (condition-case nil
- (progn
- (setq erc-server-reconnecting nil
- erc--server-reconnecting t
- erc-server-reconnect-count (1+
erc-server-reconnect-count))
- (setq delay erc-server-reconnect-timeout)
- (run-at-time delay nil
- #'erc-server-delayed-reconnect buffer))
- (error (unless (integerp erc-server-reconnect-attempts)
- (message "%s ... %s"
- "Reconnecting until we succeed"
- "kill the ERC server buffer to stop"))
- (erc-server-delayed-reconnect buffer))))))))
+ (erc-schedule-reconnect buffer))))
+ (erc-update-mode-line)))
(defun erc-process-sentinel-1 (event buffer)
"Called when `erc-process-sentinel' has decided that we're disconnecting.
@@ -992,8 +1128,37 @@ See also `erc-server-send'."
;;;; Handling responses
+(defcustom erc-tags-format 'overridable
+ "Shape of the `tags' alist in `erc-response' objects.
+When set to `legacy', pre-5.5 parsing behavior takes effect for
+the tags portion of every message. The resulting alist contains
+conses of the form (STRING . LIST), in which LIST is comprised of
+at most one, possibly empty string. When set to nil, ERC only
+parses tags if an active module defines an implementation. It
+otherwise ignores them. In such cases, each alist element is a
+cons of a symbol and an optional, nonempty string.
+
+With the default value of `overridable', ERC behaves as it does
+with `legacy' except that it emits a warning whenever first
+encountering a message containing tags in a given Emacs session.
+But it only does so when a module implementing overriding,
+non-legacy behavior isn't already active in the current network
+context.
+
+Note that future bundled modules providing IRCv3 functionality
+will not be compatible with the legacy format. User code should
+eventually transition to expecting this \"5.5+ variant\" and set
+this option to nil."
+ :package-version '(ERC . "5.4.1") ; FIXME increment on next release
+ :type '(choice (const nil)
+ (const legacy)
+ (const overridable)))
+
(defun erc-parse-tags (string)
"Parse IRCv3 tags list in STRING to a (tag . value) alist."
+ (erc--parse-message-tags string))
+
+(defun erc--parse-tags (string)
(let ((tags)
(tag-strings (split-string string ";")))
(dolist (tag-string tag-strings tags)
@@ -1003,6 +1168,28 @@ See also `erc-server-send'."
`(,pair))
tags)))))
+;; A benefit of this function being internal is not having to define a
+;; separate method just to ensure an `erc-tags-format' value of
+;; `legacy' always wins. A downside is that module code must take
+;; care to preserve that promise manually.
+
+(cl-defgeneric erc--parse-message-tags (string)
+ "Parse STRING into an alist of (TAG . VALUE) conses.
+Expect TAG to be a symbol and VALUE nil or a nonempty string.
+Don't split composite raw-input values containing commas;
+instead, leave them as a single string."
+ (when erc-tags-format
+ (unless (or (eq erc-tags-format 'legacy)
+ (get 'erc-parse-tags 'erc-v3-warned-p))
+ (put 'erc-parse-tags 'erc-v3-warned-p t)
+ (display-warning
+ 'ERC
+ (concat
+ "Legacy ERC tags behavior is currently in effect, but other modules,"
+ " including those bundled with ERC, may override this in future"
+ " releases. See `erc-tags-format' for more info.")))
+ (erc--parse-tags string)))
+
(defun erc-parse-server-response (proc string)
"Parse and act upon a complete line from an IRC server.
PROC is the process (connection) from which STRING was received.
@@ -1012,9 +1199,9 @@ PROCs `process-buffer' is `current-buffer' when this
function is called."
(let* ((tag-list (when (eq (aref string 0) ?@)
(substring string 1
(string-search " " string))))
- (msg (make-erc-response :unparsed string :tags (when tag-list
- (erc-parse-tags
- tag-list))))
+ (msg (make-erc-response :unparsed string :tags
+ (when tag-list
+ (erc--parse-message-tags tag-list))))
(string (if tag-list
(substring string (+ 1 (string-search " " string)))
string))
@@ -1662,16 +1849,6 @@ Then display the welcome message."
(split-string value ",")
(list value)))))
-(defmacro erc--with-memoization (table &rest forms)
- "Adapter to be migrated to erc-compat."
- (declare (indent defun))
- `(cond
- ((fboundp 'with-memoization)
- (with-memoization ,table ,@forms)) ; 29.1
- ((fboundp 'cl--generic-with-memoization)
- (cl--generic-with-memoization ,table ,@forms))
- (t ,@forms)))
-
(defun erc--get-isupport-entry (key &optional single)
"Return an item for \"ISUPPORT\" token KEY, a symbol.
When a lookup fails return nil. Otherwise return a list whose
@@ -1681,7 +1858,7 @@ ambiguous and only useful for tokens supporting a single
primitive value."
(if-let* ((table (or erc--isupport-params
(erc-with-server-buffer erc--isupport-params)))
- (value (erc--with-memoization (gethash key table)
+ (value (erc-compat--with-memoization (gethash key table)
(when-let ((v (assoc (symbol-name key)
erc-server-parameters)))
(if (cdr v)
diff --git a/lisp/erc/erc-button.el b/lisp/erc/erc-button.el
index bccf0e6f1f..445595e2da 100644
--- a/lisp/erc/erc-button.el
+++ b/lisp/erc/erc-button.el
@@ -248,7 +248,6 @@ specified by `erc-button-alist'."
(save-excursion
(with-syntax-table erc-button-syntax-table
(let ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
(inhibit-field-text-motion t)
(alist erc-button-alist)
regexp)
diff --git a/lisp/erc/erc-capab.el b/lisp/erc/erc-capab.el
index c590b45fd2..8759282a2a 100644
--- a/lisp/erc/erc-capab.el
+++ b/lisp/erc/erc-capab.el
@@ -62,7 +62,7 @@
;; You can customize the prefix and the face used to display it,
;; `erc-capab-identify-unidentified'. If the value of
;; `erc-capab-identify-prefix' is nil or you disable this module (see
-;; `erc-capab-identify-disable'), no prefix will be inserted, but the
+;; `erc-capab-identify-activated'), no prefix will be inserted, but the
;; flag sent by the server will still be stripped.
;;; Code:
diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el
new file mode 100644
index 0000000000..23a1933798
--- /dev/null
+++ b/lisp/erc/erc-common.el
@@ -0,0 +1,274 @@
+;;; erc-common.el --- Macros and types for ERC -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; Maintainer: Amin Bandali <bandali@gnu.org>, F. Jason Park <jp@neverwas.me>
+;; Keywords: comm, IRC, chat, client, internet
+;;
+;; 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:
+
+(eval-when-compile (require 'cl-lib) (require 'subr-x))
+(require 'erc-compat)
+
+(defvar erc--casemapping-rfc1459)
+(defvar erc--casemapping-rfc1459-strict)
+(defvar erc-channel-users)
+(defvar erc-dbuf)
+(defvar erc-log-p)
+(defvar erc-server-users)
+(defvar erc-session-server)
+
+(declare-function erc--get-isupport-entry "erc-backend" (key &optional single))
+(declare-function erc-get-buffer "erc" (target &optional proc))
+(declare-function erc-server-buffer "erc" nil)
+
+(cl-defstruct erc-input
+ string insertp sendp)
+
+(cl-defstruct (erc--input-split (:include erc-input))
+ lines cmdp)
+
+(cl-defstruct (erc-server-user (:type vector) :named)
+ ;; User data
+ nickname host login full-name info
+ ;; Buffers
+ ;;
+ ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where
+ ;; CHANNEL-DATA is either nil or an erc-channel-user struct.
+ (buffers nil))
+
+(cl-defstruct (erc-channel-user (:type vector) :named)
+ voice halfop op admin owner
+ ;; Last message time (in the form of the return value of
+ ;; (current-time)
+ ;;
+ ;; This is useful for ordered name completion.
+ (last-message-time nil))
+
+(cl-defstruct erc--target
+ (string "" :type string :documentation "Received name of target.")
+ (symbol nil :type symbol :documentation "Case-mapped name as symbol."))
+
+;; At some point, it may make sense to add a query type with an
+;; account field, which may help support reassociation across
+;; reconnects and nick changes (likely requires v3 extensions).
+;;
+;; These channel variants should probably take on a `joined' field to
+;; track "joinedness", which `erc-server-JOIN', `erc-server-PART',
+;; etc. should toggle. Functions like `erc--current-buffer-joined-p'
+;; may find it useful.
+
+(cl-defstruct (erc--target-channel (:include erc--target)))
+(cl-defstruct (erc--target-channel-local (:include erc--target-channel)))
+
+;; Beginning in 5.5/29.1, the `tags' field may take on one of two
+;; differing types. See `erc-tags-format' for details.
+
+(cl-defstruct (erc-response (:conc-name erc-response.))
+ (unparsed "" :type string)
+ (sender "" :type string)
+ (command "" :type string)
+ (command-args '() :type list)
+ (contents "" :type string)
+ (tags '() :type list))
+
+(defmacro define-erc-module (name alias doc enable-body disable-body
+ &optional local-p)
+ "Define a new minor mode using ERC conventions.
+Symbol NAME is the name of the module.
+Symbol ALIAS is the alias to use, or nil.
+DOC is the documentation string to use for the minor mode.
+ENABLE-BODY is a list of expressions used to enable the mode.
+DISABLE-BODY is a list of expressions used to disable the mode.
+If LOCAL-P is non-nil, the mode will be created as a buffer-local
+mode, rather than a global one.
+
+This will define a minor mode called erc-NAME-mode, possibly
+an alias erc-ALIAS-mode, as well as the helper functions
+erc-NAME-enable, and erc-NAME-disable.
+
+Example:
+
+ ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\")
+ (define-erc-module replace nil
+ \"This mode replaces incoming text according to `erc-replace-alist'.\"
+ ((add-hook \\='erc-insert-modify-hook
+ #\\='erc-replace-insert))
+ ((remove-hook \\='erc-insert-modify-hook
+ #\\='erc-replace-insert)))"
+ (declare (doc-string 3) (indent defun))
+ (let* ((sn (symbol-name name))
+ (mode (intern (format "erc-%s-mode" (downcase sn))))
+ (group (intern (format "erc-%s" (downcase sn))))
+ (enable (intern (format "erc-%s-enable" (downcase sn))))
+ (disable (intern (format "erc-%s-disable" (downcase sn)))))
+ `(progn
+ (define-minor-mode
+ ,mode
+ ,(format "Toggle ERC %S mode.
+With a prefix argument ARG, enable %s if ARG is positive,
+and disable it otherwise. If called from Lisp, enable the mode
+if ARG is omitted or nil.
+%s" name name doc)
+ ;; FIXME: We don't know if this group exists, so this `:group' may
+ ;; actually just silence a valid warning about the fact that the var
+ ;; is not associated with any group.
+ :global ,(not local-p) :group (quote ,group)
+ (if ,mode
+ (,enable)
+ (,disable)))
+ (defun ,enable ()
+ ,(format "Enable ERC %S mode."
+ name)
+ (interactive)
+ (add-to-list 'erc-modules (quote ,name))
+ (setq ,mode t)
+ ,@enable-body)
+ (defun ,disable ()
+ ,(format "Disable ERC %S mode."
+ name)
+ (interactive)
+ (setq erc-modules (delq (quote ,name) erc-modules))
+ (setq ,mode nil)
+ ,@disable-body)
+ ,(when (and alias (not (eq name alias)))
+ `(defalias
+ ',(intern
+ (format "erc-%s-mode"
+ (downcase (symbol-name alias))))
+ #',mode))
+ ;; For find-function and find-variable.
+ (put ',mode 'definition-name ',name)
+ (put ',enable 'definition-name ',name)
+ (put ',disable 'definition-name ',name))))
+
+(defmacro erc-with-buffer (spec &rest body)
+ "Execute BODY in the buffer associated with SPEC.
+
+SPEC should have the form
+
+ (TARGET [PROCESS])
+
+If TARGET is a buffer, use it. Otherwise, use the buffer
+matching TARGET in the process specified by PROCESS.
+
+If PROCESS is nil, use the current `erc-server-process'.
+See `erc-get-buffer' for details.
+
+See also `with-current-buffer'.
+
+\(fn (TARGET [PROCESS]) BODY...)"
+ (declare (indent 1) (debug ((form &optional form) body)))
+ (let ((buf (make-symbol "buf"))
+ (proc (make-symbol "proc"))
+ (target (make-symbol "target"))
+ (process (make-symbol "process")))
+ `(let* ((,target ,(car spec))
+ (,process ,(cadr spec))
+ (,buf (if (bufferp ,target)
+ ,target
+ (let ((,proc (or ,process
+ (and (processp erc-server-process)
+ erc-server-process))))
+ (if (and ,target ,proc)
+ (erc-get-buffer ,target ,proc))))))
+ (when (buffer-live-p ,buf)
+ (with-current-buffer ,buf
+ ,@body)))))
+
+(defmacro erc-with-server-buffer (&rest body)
+ "Execute BODY in the current ERC server buffer.
+If no server buffer exists, return nil."
+ (declare (indent 0) (debug (body)))
+ (let ((buffer (make-symbol "buffer")))
+ `(let ((,buffer (erc-server-buffer)))
+ (when (buffer-live-p ,buffer)
+ (with-current-buffer ,buffer
+ ,@body)))))
+
+(defmacro erc-with-all-buffers-of-server (process pred &rest forms)
+ "Execute FORMS in all buffers which have same process as this server.
+FORMS will be evaluated in all buffers having the process PROCESS and
+where PRED matches or in all buffers of the server process if PRED is
+nil."
+ (declare (indent 2) (debug (form form body)))
+ (macroexp-let2 nil pred pred
+ `(erc-buffer-filter (lambda ()
+ (when (or (not ,pred) (funcall ,pred))
+ ,@forms))
+ ,process)))
+
+(defun erc-log-aux (string)
+ "Do the debug logging of STRING."
+ (let ((cb (current-buffer))
+ (point 1)
+ (was-eob nil)
+ (session-buffer (erc-server-buffer)))
+ (if session-buffer
+ (progn
+ (set-buffer session-buffer)
+ (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf)))
+ (progn
+ (setq erc-dbuf (get-buffer-create
+ (concat "*ERC-DEBUG: "
+ erc-session-server "*")))))
+ (set-buffer erc-dbuf)
+ (setq point (point))
+ (setq was-eob (eobp))
+ (goto-char (point-max))
+ (insert (concat "** " string "\n"))
+ (if was-eob (goto-char (point-max))
+ (goto-char point))
+ (set-buffer cb))
+ (message "ERC: ** %s" string))))
+
+(define-inline erc-log (string)
+ "Logs STRING if logging is on (see `erc-log-p')."
+ (inline-quote
+ (when erc-log-p
+ (erc-log-aux ,string))))
+
+(defun erc-downcase (string)
+ "Return a downcased copy of STRING with properties.
+Use the CASEMAPPING ISUPPORT parameter to determine the style."
+ (let* ((mapping (erc--get-isupport-entry 'CASEMAPPING 'single))
+ (inhibit-read-only t))
+ (if (equal mapping "ascii")
+ (downcase string)
+ (with-temp-buffer
+ (insert string)
+ (translate-region (point-min) (point-max)
+ (if (equal mapping "rfc1459-strict")
+ erc--casemapping-rfc1459-strict
+ erc--casemapping-rfc1459))
+ (buffer-string)))))
+
+(define-inline erc-get-channel-user (nick)
+ "Find NICK in the current buffer's `erc-channel-users' hash table."
+ (inline-quote (gethash (erc-downcase ,nick) erc-channel-users)))
+
+(define-inline erc-get-server-user (nick)
+ "Find NICK in the current server's `erc-server-users' hash table."
+ (inline-letevals (nick)
+ (inline-quote (erc-with-server-buffer
+ (gethash (erc-downcase ,nick) erc-server-users)))))
+
+(provide 'erc-common)
+
+;;; erc-common.el ends here
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 8a00e711ac..d23703394b 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -32,6 +32,7 @@
;;; Code:
(require 'compat nil 'noerror)
+(eval-when-compile (require 'cl-lib) (require 'url-parse))
;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
(define-obsolete-function-alias 'erc-define-minor-mode
@@ -156,6 +157,162 @@ If START or END is negative, it counts from the end."
(setq i (1+ i) start (1+ start)))
res))))))
+
+;;;; Auth Source
+
+(declare-function auth-source-pass--get-attr
+ "auth-source-pass" (key entry-data))
+(declare-function auth-source-pass--disambiguate
+ "auth-source-pass" (host &optional user port))
+(declare-function auth-source-backend-parse-parameters
+ "auth-source-pass" (entry backend))
+(declare-function auth-source-backend "auth-source" (&rest slots))
+(declare-function auth-source-pass-entries "auth-source-pass" nil)
+(declare-function auth-source-pass-parse-entry "auth-source-pass" (entry))
+
+(defvar auth-sources)
+(defvar auth-source-backend-parser-functions)
+
+;; This hard codes `auth-source-pass-port-separator' to ":"
+(defun erc-compat--29-auth-source-pass--retrieve-parsed (seen e port-number-p)
+ (when (string-match (rx (or bot "/")
+ (or (: (? (group-n 20 (+ (not (in " /@")))) "@")
+ (group-n 10 (+ (not (in " /:@"))))
+ (? ":" (group-n 30 (+ (not (in " /:"))))))
+ (: (group-n 11 (+ (not (in " /:@"))))
+ (? ":" (group-n 31 (+ (not (in " /:")))))
+ (? "/" (group-n 21 (+ (not (in " /:")))))))
+ eot)
+ e)
+ (puthash e `( :host ,(or (match-string 10 e) (match-string 11 e))
+ ,@(if-let* ((tr (match-string 21 e)))
+ (list :user tr :suffix t)
+ (list :user (match-string 20 e)))
+ :port ,(and-let* ((p (or (match-string 30 e)
+ (match-string 31 e)))
+ (n (string-to-number p)))
+ (if (or (zerop n) (not port-number-p))
+ (format "%s" p)
+ n)))
+ seen)))
+
+;; This looks bad, but it just inlines `auth-source-pass--find-match-many'.
+(defun erc-compat--29-auth-source-pass--build-result-many
+ (hosts users ports require max)
+ "Return a plist of HOSTS, PORTS, USERS, and secret."
+ (unless (listp hosts) (setq hosts (list hosts)))
+ (unless (listp users) (setq users (list users)))
+ (unless (listp ports) (setq ports (list ports)))
+ (unless max (setq max 1))
+ (let ((seen (make-hash-table :test #'equal))
+ (entries (auth-source-pass-entries))
+ (check (lambda (m k v)
+ (let ((mv (plist-get m k)))
+ (if (memq k require)
+ (and v (equal mv v))
+ (or (not v) (not mv) (equal mv v))))))
+ out suffixed suffixedp)
+ (catch 'done
+ (dolist (host hosts)
+ (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host)))
+ (unless (or (not (equal "443" p)) (string-prefix-p "https://"; host))
+ (setq p nil))
+ (dolist (user (or users (list u)))
+ (dolist (port (or ports (list p)))
+ (dolist (e entries)
+ (when-let*
+ ((m (or (gethash e seen)
+ (erc-compat--29-auth-source-pass--retrieve-parsed
+ seen e (integerp port))))
+ ((equal host (plist-get m :host)))
+ ((funcall check m :port port))
+ ((funcall check m :user user))
+ (parsed (auth-source-pass-parse-entry e))
+ (secret (or (auth-source-pass--get-attr 'secret parsed)
+ (not (memq :secret require)))))
+ (push
+ `( :host ,host ; prefer user-provided :host over h
+ ,@(and-let* ((u (plist-get m :user))) (list :user u))
+ ,@(and-let* ((p (plist-get m :port))) (list :port p))
+ ,@(and secret (not (eq secret t)) (list :secret secret)))
+ (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+ (unless suffixedp
+ (when (or (zerop (cl-decf max))
+ (null (setq entries (delete e entries))))
+ (throw 'done out)))))
+ (setq suffixed (nreverse suffixed))
+ (while suffixed
+ (push (pop suffixed) out)
+ (when (zerop (cl-decf max))
+ (throw 'done out))))))))
+ (reverse out)))
+
+(cl-defun erc-compat--29-auth-source-pass-search
+ (&rest spec &key host user port require max &allow-other-keys)
+ ;; From `auth-source-pass-search'
+ (cl-assert (and host (not (eq host t)))
+ t "Invalid password-store search: %s %s")
+ (erc-compat--29-auth-source-pass--build-result-many
+ host user port require max))
+
+(defun erc-compat--29-auth-source-pass-backend-parse (entry)
+ (when (eq entry 'password-store)
+ (auth-source-backend-parse-parameters
+ entry (auth-source-backend
+ :source "."
+ :type 'password-store
+ :search-function #'erc-compat--29-auth-source-pass-search))))
+
+(defun erc-compat--auth-source-backend-parser-functions ()
+ (if (memq 'password-store auth-sources)
+ (progn
+ (require 'auth-source-pass)
+ `(,@(unless (bound-and-true-p auth-source-pass-extra-query-keywords)
+ '(erc-compat--29-auth-source-pass-backend-parse))
+ ,@auth-source-backend-parser-functions))
+ auth-source-backend-parser-functions))
+
+
+;;;; Misc 29.1
+
+(defmacro erc-compat--with-memoization (table &rest forms)
+ (declare (indent defun))
+ (cond
+ ((fboundp 'with-memoization)
+ `(with-memoization ,table ,@forms)) ; 29.1
+ ((fboundp 'cl--generic-with-memoization)
+ `(cl--generic-with-memoization ,table ,@forms))
+ (t `(progn ,@forms))))
+
+(defvar url-irc-function)
+
+(defun erc-compat--29-browse-url-irc (string &rest _)
+ (require 'url-irc)
+ (let* ((url (url-generic-parse-url string))
+ (url-irc-function
+ (if (function-equal url-irc-function 'url-irc-erc)
+ (lambda (host port chan user pass)
+ (erc-handle-irc-url host port chan user pass (url-type url)))
+ url-irc-function)))
+ (url-irc url)))
+
+(cond ((fboundp 'browse-url-irc)) ; 29
+ ((boundp 'browse-url-default-handlers) ; 28
+ (cl-pushnew '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
+ browse-url-default-handlers))
+ ((boundp 'browse-url-browser-function) ; 27
+ (require 'browse-url)
+ (let ((existing browse-url-browser-function))
+ (setq browse-url-browser-function
+ (if (functionp existing)
+ (lambda (u &rest r)
+ (apply (if (string-match-p "\\`irc6?s?://" u)
+ #'erc-compat--29-browse-url-irc
+ existing)
+ u r))
+ (cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc)
+ existing))))))
+
(provide 'erc-compat)
;;; erc-compat.el ends here
diff --git a/lisp/erc/erc-dcc.el b/lisp/erc/erc-dcc.el
index 90a10766c4..ebeab921fb 100644
--- a/lisp/erc/erc-dcc.el
+++ b/lisp/erc/erc-dcc.el
@@ -411,8 +411,11 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
"Provide completion for the /DCC command."
(pcomplete-here (append '("chat" "close" "get" "list")
(when (fboundp 'make-network-process) '("send"))))
+ (when (equal "get" (downcase (pcomplete-arg 1)))
+ (pcomplete-opt "ts")
+ (pcomplete-opt (if (equal "-s" (pcomplete-arg 'first 2)) "t" "s")))
(pcomplete-here
- (pcase (intern (downcase (pcomplete-arg 1)))
+ (pcase (intern (downcase (pcomplete-arg 'first 1)))
('chat (mapcar (lambda (elt) (plist-get elt :nick))
(cl-remove-if-not
(lambda (elt)
@@ -428,7 +431,7 @@ where FOO is one of CLOSE, GET, SEND, LIST, CHAT, etc."
erc-dcc-list)))
('send (pcomplete-erc-all-nicks))))
(pcomplete-here
- (pcase (intern (downcase (pcomplete-arg 2)))
+ (pcase (intern (downcase (pcomplete-arg 'first 1)))
('get (mapcar (lambda (elt) (plist-get elt :file))
(cl-remove-if-not
(lambda (elt)
diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el
index 8fef23945d..59b5f01f23 100644
--- a/lisp/erc/erc-goodies.el
+++ b/lisp/erc/erc-goodies.el
@@ -29,10 +29,23 @@
;;; Code:
-(require 'erc)
-
;;; Imenu support
+(require 'erc-common)
+
+(defvar erc-controls-highlight-regexp)
+(defvar erc-controls-remove-regexp)
+(defvar erc-input-marker)
+(defvar erc-insert-marker)
+(defvar erc-server-process)
+(defvar erc-modules)
+(defvar erc-log-p)
+
+(declare-function erc-buffer-list "erc" (&optional predicate proc))
+(declare-function erc-error "erc" (&rest args))
+(declare-function erc-extract-command-from-line "erc" (line))
+(declare-function erc-beg-of-input-line "erc" nil)
+
(defun erc-imenu-setup ()
"Setup Imenu support in an ERC buffer."
(setq-local imenu-create-index-function #'erc-create-imenu-index))
diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el
index 2c8f8fb72b..b3e5fcf1a3 100644
--- a/lisp/erc/erc-networks.el
+++ b/lisp/erc/erc-networks.el
@@ -39,8 +39,32 @@
;;; Code:
-(require 'erc)
(eval-when-compile (require 'cl-lib))
+(require 'erc-common)
+
+(defvar erc--target)
+(defvar erc-insert-marker)
+(defvar erc-kill-buffer-hook)
+(defvar erc-kill-server-hook)
+(defvar erc-modules)
+(defvar erc-rename-buffers)
+(defvar erc-reuse-buffers)
+(defvar erc-server-announced-name)
+(defvar erc-server-connected)
+(defvar erc-server-parameters)
+(defvar erc-server-process)
+(defvar erc-session-server)
+
+(declare-function erc--default-target "erc" nil)
+(declare-function erc--get-isupport-entry "erc-backend" (key &optional single))
+(declare-function erc-buffer-filter "erc" (predicate &optional proc))
+(declare-function erc-current-nick "erc" nil)
+(declare-function erc-display-error-notice "erc" (parsed string))
+(declare-function erc-error "erc" (&rest args))
+(declare-function erc-get-buffer "erc" (target &optional proc))
+(declare-function erc-server-buffer "erc" nil)
+(declare-function erc-server-process-alive "erc-backend" (&optional buffer))
+(declare-function erc-set-active-buffer "erc" (buffer))
;; Variables
@@ -813,7 +837,7 @@ This may have originated from an `:id' arg to entry-point
commands
(erc-networks--id-symbol nid))
(cl-generic-define-context-rewriter erc-obsolete-var (var spec)
- `((with-suppressed-warnings ((obsolete ,var)) ,var) ,spec))
+ `((with-suppressed-warnings ((obsolete ,var) (free-vars ,var)) ,var) ,spec))
;; As a catch-all, derive the symbol from the unquoted printed repr.
(cl-defgeneric erc-networks--id-create (id)
@@ -1232,14 +1256,15 @@ server name and search for a match in
`erc-networks-alist'."
(defconst erc-networks--name-missing-sentinel (gensym "Unknown ")
"Value to cover rare case of a literal NETWORK=nil.")
-(defun erc-networks--determine ()
+(defun erc-networks--determine (&optional server)
"Return the name of the network as a symbol.
-Search `erc-networks-alist' for a known entity matching
+Search `erc-networks-alist' for a known entity matching SERVER or
`erc-server-announced-name'. If that fails, use the display name
given by the `RPL_ISUPPORT' NETWORK parameter."
(or (cl-loop for (name matcher) in erc-networks-alist
- when (and matcher (string-match (concat matcher "\\'")
- erc-server-announced-name))
+ when (and matcher
+ (string-match (concat matcher "\\'")
+ (or server erc-server-announced-name)))
return name)
(and-let* ((vanity (erc--get-isupport-entry 'NETWORK 'single))
((intern vanity))))
@@ -1256,7 +1281,7 @@ Signal an error when the network cannot be determined."
;; but aren't being proxied through to a real network. The
;; service may send a 422 but no NETWORK param (or *any* 005s).
(let ((m (concat "Failed to determine network. Please set entry for "
- erc-server-announced-name " in `erc-network-alist'.")))
+ erc-server-announced-name " in `erc-networks-alist'.")))
(erc-display-error-notice parsed m)
(erc-error "Failed to determine network"))) ; beep
(setq erc-network name))
diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el
index af8528dbc3..3ba18e835b 100644
--- a/lisp/erc/erc-pcomplete.el
+++ b/lisp/erc/erc-pcomplete.el
@@ -179,6 +179,10 @@ for use on `completion-at-point-function'."
(defun pcomplete/erc-mode/UNIGNORE ()
(pcomplete-here (erc-with-server-buffer erc-ignore-list)))
+(defun pcomplete/erc-mode/RECONNECT ()
+ (pcomplete-here '("cancel"))
+ (pcomplete-opt "a"))
+
;;; Functions that provide possible completions.
(defun pcomplete-erc-commands ()
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 20f22c896f..2312246e3e 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -60,6 +60,9 @@
(load "erc-loaddefs" 'noerror 'nomessage)
+(require 'erc-networks)
+(require 'erc-goodies)
+(require 'erc-backend)
(require 'cl-lib)
(require 'format-spec)
(require 'pp)
@@ -67,9 +70,7 @@
(require 'auth-source)
(require 'time-date)
(require 'iso8601)
-(eval-when-compile (require 'subr-x))
-
-(require 'erc-compat)
+(eval-when-compile (require 'subr-x) (require 'url-parse))
(defconst erc-version "5.4.1"
"This version of ERC.")
@@ -132,29 +133,12 @@
"Running scripts at startup and with /LOAD."
:group 'erc)
-;; Defined in erc-backend
-(defvar erc--server-last-reconnect-count)
-(defvar erc--server-reconnecting)
-(defvar erc-channel-members-changed-hook)
-(defvar erc-network)
-(defvar erc-networks--id)
-(defvar erc-server-367-functions)
-(defvar erc-server-announced-name)
-(defvar erc-server-connect-function)
-(defvar erc-server-connected)
-(defvar erc-server-current-nick)
-(defvar erc-server-lag)
-(defvar erc-server-last-sent-time)
-(defvar erc-server-process)
-(defvar erc-server-quitting)
-(defvar erc-server-reconnect-count)
-(defvar erc-server-reconnecting)
-(defvar erc-session-client-certificate)
-(defvar erc-session-connector)
-(defvar erc-session-port)
-(defvar erc-session-server)
-(defvar erc-session-user-full-name)
-(defvar erc-session-username)
+;; Forward declarations
+(defvar erc-message-parsed)
+
+(defvar tabbar--local-hlf)
+(defvar motif-version-string)
+(defvar gtk-version-string)
;; tunable connection and authentication parameters
@@ -349,9 +333,6 @@ A typical value would be \((\"#emacs\" \"QUIT\" \"JOIN\")
:group 'erc-ignore
:type 'erc-message-type)
-(defvar-local erc-session-password nil
- "The password used for the current session.")
-
(defcustom erc-disconnected-hook nil
"Run this hook with arguments (NICK IP REASON) when disconnected.
This happens before automatic reconnection. Note, that
@@ -436,69 +417,14 @@ It associates nicknames with `erc-server-user' struct
instances.")
'((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|))
(mapcar (lambda (c) (cons c (+ c 32))) "ABCDEFGHIJKLMNOPQRSTUVWXYZ")))
-(defun erc-downcase (string)
- "Return a downcased copy of STRING with properties.
-Use the CASEMAPPING ISUPPORT parameter to determine the style."
- (let* ((mapping (erc--get-isupport-entry 'CASEMAPPING 'single))
- (inhibit-read-only t))
- (if (equal mapping "ascii")
- (downcase string)
- (with-temp-buffer
- (insert string)
- (translate-region (point-min) (point-max)
- (if (equal mapping "rfc1459-strict")
- erc--casemapping-rfc1459-strict
- erc--casemapping-rfc1459))
- (buffer-string)))))
-
-(defmacro erc-with-server-buffer (&rest body)
- "Execute BODY in the current ERC server buffer.
-If no server buffer exists, return nil."
- (declare (indent 0) (debug (body)))
- (let ((buffer (make-symbol "buffer")))
- `(let ((,buffer (erc-server-buffer)))
- (when (buffer-live-p ,buffer)
- (with-current-buffer ,buffer
- ,@body)))))
-
-(cl-defstruct (erc-server-user (:type vector) :named)
- ;; User data
- nickname host login full-name info
- ;; Buffers
- ;;
- ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where
- ;; CHANNEL-DATA is either nil or an erc-channel-user struct.
- (buffers nil)
- )
-
-(cl-defstruct (erc-channel-user (:type vector) :named)
- voice halfop op admin owner
- ;; Last message time (in the form of the return value of
- ;; (current-time)
- ;;
- ;; This is useful for ordered name completion.
- (last-message-time nil))
-
-(define-inline erc-get-channel-user (nick)
- "Find NICK in the current buffer's `erc-channel-users' hash table."
- (inline-quote (gethash (erc-downcase ,nick) erc-channel-users)))
-
-(define-inline erc-get-server-user (nick)
- "Find NICK in the current server's `erc-server-users' hash table."
- (inline-letevals (nick)
- (inline-quote (erc-with-server-buffer
- (gethash (erc-downcase ,nick) erc-server-users)))))
-
-(define-inline erc-add-server-user (nick user)
+(defun erc-add-server-user (nick user)
"This function is for internal use only.
Adds USER with nickname NICK to the `erc-server-users' hash table."
- (inline-letevals (nick user)
- (inline-quote
- (erc-with-server-buffer
- (puthash (erc-downcase ,nick) ,user erc-server-users)))))
+ (erc-with-server-buffer
+ (puthash (erc-downcase nick) user erc-server-users)))
-(define-inline erc-remove-server-user (nick)
+(defun erc-remove-server-user (nick)
"This function is for internal use only.
Removes the user with nickname NICK from the `erc-server-users'
@@ -506,10 +432,8 @@ hash table. This user is not removed from the
`erc-channel-users' lists of other buffers.
See also: `erc-remove-user'."
- (inline-letevals (nick)
- (inline-quote
- (erc-with-server-buffer
- (remhash (erc-downcase ,nick) erc-server-users)))))
+ (erc-with-server-buffer
+ (remhash (erc-downcase nick) erc-server-users)))
(defun erc-change-user-nickname (user new-nick)
"This function is for internal use only.
@@ -580,55 +504,45 @@ Removes all users in the current channel. This is called
by
erc-channel-users)
(clrhash erc-channel-users)))
-(define-inline erc-channel-user-owner-p (nick)
+(defun erc-channel-user-owner-p (nick)
"Return non-nil if NICK is an owner of the current channel."
- (inline-letevals (nick)
- (inline-quote
- (and ,nick
- (hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user ,nick)))
- (and cdata (cdr cdata)
- (erc-channel-user-owner (cdr cdata))))))))
-
-(define-inline erc-channel-user-admin-p (nick)
+ (and nick
+ (hash-table-p erc-channel-users)
+ (let ((cdata (erc-get-channel-user nick)))
+ (and cdata (cdr cdata)
+ (erc-channel-user-owner (cdr cdata))))))
+
+(defun erc-channel-user-admin-p (nick)
"Return non-nil if NICK is an admin in the current channel."
- (inline-letevals (nick)
- (inline-quote
- (and ,nick
+ (and nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user ,nick)))
+ (let ((cdata (erc-get-channel-user nick)))
(and cdata (cdr cdata)
- (erc-channel-user-admin (cdr cdata))))))))
+ (erc-channel-user-admin (cdr cdata))))))
-(define-inline erc-channel-user-op-p (nick)
+(defun erc-channel-user-op-p (nick)
"Return non-nil if NICK is an operator in the current channel."
- (inline-letevals (nick)
- (inline-quote
- (and ,nick
+ (and nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user ,nick)))
+ (let ((cdata (erc-get-channel-user nick)))
(and cdata (cdr cdata)
- (erc-channel-user-op (cdr cdata))))))))
+ (erc-channel-user-op (cdr cdata))))))
-(define-inline erc-channel-user-halfop-p (nick)
+(defun erc-channel-user-halfop-p (nick)
"Return non-nil if NICK is a half-operator in the current channel."
- (inline-letevals (nick)
- (inline-quote
- (and ,nick
+ (and nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user ,nick)))
+ (let ((cdata (erc-get-channel-user nick)))
(and cdata (cdr cdata)
- (erc-channel-user-halfop (cdr cdata))))))))
+ (erc-channel-user-halfop (cdr cdata))))))
-(define-inline erc-channel-user-voice-p (nick)
+(defun erc-channel-user-voice-p (nick)
"Return non-nil if NICK has voice in the current channel."
- (inline-letevals (nick)
- (inline-quote
- (and ,nick
+ (and nick
(hash-table-p erc-channel-users)
- (let ((cdata (erc-get-channel-user ,nick)))
+ (let ((cdata (erc-get-channel-user nick)))
(and cdata (cdr cdata)
- (erc-channel-user-voice (cdr cdata))))))))
+ (erc-channel-user-voice (cdr cdata))))))
(defun erc-get-channel-user-list ()
"Return a list of users in the current channel.
@@ -1377,96 +1291,6 @@ See also `erc-show-my-nick'."
(defvar-local erc-dbuf nil)
-(defmacro define-erc-module (name alias doc enable-body disable-body
- &optional local-p)
- "Define a new minor mode using ERC conventions.
-Symbol NAME is the name of the module.
-Symbol ALIAS is the alias to use, or nil.
-DOC is the documentation string to use for the minor mode.
-ENABLE-BODY is a list of expressions used to enable the mode.
-DISABLE-BODY is a list of expressions used to disable the mode.
-If LOCAL-P is non-nil, the mode will be created as a buffer-local
-mode, rather than a global one.
-
-This will define a minor mode called erc-NAME-mode, possibly
-an alias erc-ALIAS-mode, as well as the helper functions
-erc-NAME-enable, and erc-NAME-disable.
-
-Example:
-
- ;;;###autoload(autoload \\='erc-replace-mode \"erc-replace\")
- (define-erc-module replace nil
- \"This mode replaces incoming text according to `erc-replace-alist'.\"
- ((add-hook \\='erc-insert-modify-hook
- #\\='erc-replace-insert))
- ((remove-hook \\='erc-insert-modify-hook
- #\\='erc-replace-insert)))"
- (declare (doc-string 3) (indent defun))
- (let* ((sn (symbol-name name))
- (mode (intern (format "erc-%s-mode" (downcase sn))))
- (group (intern (format "erc-%s" (downcase sn))))
- (enable (intern (format "erc-%s-enable" (downcase sn))))
- (disable (intern (format "erc-%s-disable" (downcase sn)))))
- `(progn
- (define-minor-mode
- ,mode
- ,(format "Toggle ERC %S mode.
-With a prefix argument ARG, enable %s if ARG is positive,
-and disable it otherwise. If called from Lisp, enable the mode
-if ARG is omitted or nil.
-%s" name name doc)
- ;; FIXME: We don't know if this group exists, so this `:group' may
- ;; actually just silence a valid warning about the fact that the var
- ;; is not associated with any group.
- :global ,(not local-p) :group (quote ,group)
- (if ,mode
- (,enable)
- (,disable)))
- (defun ,enable ()
- ,(format "Enable ERC %S mode."
- name)
- (interactive)
- (add-to-list 'erc-modules (quote ,name))
- (setq ,mode t)
- ,@enable-body)
- (defun ,disable ()
- ,(format "Disable ERC %S mode."
- name)
- (interactive)
- (setq erc-modules (delq (quote ,name) erc-modules))
- (setq ,mode nil)
- ,@disable-body)
- ,(when (and alias (not (eq name alias)))
- `(defalias
- ',(intern
- (format "erc-%s-mode"
- (downcase (symbol-name alias))))
- #',mode))
- ;; For find-function and find-variable.
- (put ',mode 'definition-name ',name)
- (put ',enable 'definition-name ',name)
- (put ',disable 'definition-name ',name))))
-
-;; The rationale for favoring inheritance here (nicer dispatch) is
-;; kinda flimsy since there aren't yet any actual methods.
-
-(cl-defstruct erc--target
- (string "" :type string :documentation "Received name of target.")
- (symbol nil :type symbol :documentation "Case-mapped name as symbol."))
-
-;; These should probably take on a `joined' field to track joinedness,
-;; which should be toggled by `erc-server-JOIN', `erc-server-PART',
-;; etc. Functions like `erc--current-buffer-joined-p' (bug#48598) may
-;; find it useful.
-
-(cl-defstruct (erc--target-channel (:include erc--target)))
-
-(cl-defstruct (erc--target-channel-local (:include erc--target-channel)))
-
-;; At some point, it may make sense to add a query type with an
-;; account field, which may help support reassociation across
-;; reconnects and nick changes (likely requires v3 extensions).
-
(defun erc--target-from-string (string)
"Construct an `erc--target' variant from STRING."
(funcall (if (erc-channel-p string)
@@ -1516,12 +1340,6 @@ capabilities."
(add-hook hook fun nil t)
fun))
-(define-inline erc-log (string)
- "Logs STRING if logging is on (see `erc-log-p')."
- (inline-quote
- (when erc-log-p
- (erc-log-aux ,string))))
-
(defun erc-server-buffer ()
"Return the server buffer for the current buffer's process.
The buffer-local variable `erc-server-process' is used to find
@@ -1577,29 +1395,7 @@ If BUFFER is nil, the current buffer is used."
(if erc-online-p "" "not "))
erc-online-p))))
-(defun erc-log-aux (string)
- "Do the debug logging of STRING."
- (let ((cb (current-buffer))
- (point 1)
- (was-eob nil)
- (session-buffer (erc-server-buffer)))
- (if session-buffer
- (progn
- (set-buffer session-buffer)
- (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf)))
- (progn
- (setq erc-dbuf (get-buffer-create
- (concat "*ERC-DEBUG: "
- erc-session-server "*")))))
- (set-buffer erc-dbuf)
- (setq point (point))
- (setq was-eob (eobp))
- (goto-char (point-max))
- (insert (concat "** " string "\n"))
- (if was-eob (goto-char (point-max))
- (goto-char point))
- (set-buffer cb))
- (message "ERC: ** %s" string))))
+
;; Last active buffer, to print server messages in the right place
@@ -1746,6 +1542,11 @@ symbol, it may have these values:
* ircs -> 994
* ircd -> 6667
* ircd-dalnet -> 7000"
+ ;; These were updated somewhat in 2022 to reflect modern standards
+ ;; and practices. See also:
+ ;;
+ ;; https://datatracker.ietf.org/doc/html/rfc7194#section-1
+ ;; https://www.iana.org/assignments/service-names-port-numbers
(cond
((symbolp port)
(erc-normalize-port (symbol-name port)))
@@ -1758,8 +1559,10 @@ symbol, it may have these values:
194)
((string-equal port "ircs")
994)
- ((string-equal port "ircd")
+ ((string-equal port "ircu") 6667) ; 6665-6669
+ ((string-equal port "ircd") ; nonstandard (irc-serv is 529)
6667)
+ ((string-equal port "ircs-u") 6697)
((string-equal port "ircd-dalnet")
7000)
(t
@@ -1841,40 +1644,6 @@ All strings are compared according to IRC protocol case
rules, see
(throw 'result list)
(setq list (cdr list))))))
-(defmacro erc-with-buffer (spec &rest body)
- "Execute BODY in the buffer associated with SPEC.
-
-SPEC should have the form
-
- (TARGET [PROCESS])
-
-If TARGET is a buffer, use it. Otherwise, use the buffer
-matching TARGET in the process specified by PROCESS.
-
-If PROCESS is nil, use the current `erc-server-process'.
-See `erc-get-buffer' for details.
-
-See also `with-current-buffer'.
-
-\(fn (TARGET [PROCESS]) BODY...)"
- (declare (indent 1) (debug ((form &optional form) body)))
- (let ((buf (make-symbol "buf"))
- (proc (make-symbol "proc"))
- (target (make-symbol "target"))
- (process (make-symbol "process")))
- `(let* ((,target ,(car spec))
- (,process ,(cadr spec))
- (,buf (if (bufferp ,target)
- ,target
- (let ((,proc (or ,process
- (and (processp erc-server-process)
- erc-server-process))))
- (if (and ,target ,proc)
- (erc-get-buffer ,target ,proc))))))
- (when (buffer-live-p ,buf)
- (with-current-buffer ,buf
- ,@body)))))
-
(defun erc-get-buffer (target &optional proc)
"Return the buffer matching TARGET in the process PROC.
If PROC is not supplied, all processes are searched."
@@ -1921,18 +1690,6 @@ needs to match PROC."
(setq predicate (lambda () t)))
(erc-buffer-filter predicate proc))
-(defmacro erc-with-all-buffers-of-server (process pred &rest forms)
- "Execute FORMS in all buffers which have same process as this server.
-FORMS will be evaluated in all buffers having the process PROCESS and
-where PRED matches or in all buffers of the server process if PRED is
-nil."
- (declare (indent 1) (debug (form form body)))
- (macroexp-let2 nil pred pred
- `(erc-buffer-filter (lambda ()
- (when (or (not ,pred) (funcall ,pred))
- ,@forms))
- ,process)))
-
(define-obsolete-function-alias 'erc-iswitchb #'erc-switch-to-buffer "25.1")
(defun erc--switch-to-buffer (&optional arg)
(read-buffer "Switch to ERC buffer: "
@@ -2174,7 +1931,9 @@ removed from the list will be disabled."
If CONNECT is non-nil, connect to the server. Otherwise assume
already connected and just create a separate buffer for the new
-target CHANNEL.
+target given by CHANNEL, meaning these parameters are mutually
+exclusive. Note that CHANNEL may also be a query; its name has
+been retained for historical reasons.
Use PASSWD as user password on the server. If TGT-LIST is
non-nil, use it to initialize `erc-default-recipients'.
@@ -2282,12 +2041,12 @@ Returns the buffer for the given server or channel."
;; Saving log file on exit
(run-hook-with-args 'erc-connect-pre-hook buffer)
- (when connect
- (erc-server-connect erc-session-server
- erc-session-port
- buffer
- erc-session-client-certificate))
- (erc-update-mode-line)
+ (if connect
+ (erc-server-connect erc-session-server
+ erc-session-port
+ buffer
+ erc-session-client-certificate)
+ (erc-update-mode-line))
;; Now display the buffer in a window as per user wishes.
(unless (eq buffer old-buffer)
@@ -2344,52 +2103,51 @@ parameters SERVER and NICK."
:group 'erc-hooks
:type '(repeat function))
+(defun erc--ensure-url (input)
+ (unless (string-match (rx bot "irc" (? "6") (? "s") "://") input)
+ (when (and (string-match (rx (? (+ any) "@")
+ (or (group (* (not "[")) ":" (* any))
+ (+ any))
+ ":" (+ (not (any ":]"))) eot)
+ input)
+ (match-beginning 1))
+ (setq input (concat "[" (substring input (match-beginning 1)) "]")))
+ (setq input (concat "irc://" input)))
+ input)
+
;;;###autoload
(defun erc-select-read-args ()
"Prompt the user for values of nick, server, port, and password."
- (let (user-input server port nick passwd)
- (setq user-input (read-string
- "IRC server: "
- (erc-compute-server) 'erc-server-history-list))
-
- (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input)
- (setq port (erc-string-to-port (match-string 2 user-input))
- user-input (match-string 1 user-input))
- (setq port
- (erc-string-to-port (read-string
- "IRC port: " (erc-port-to-string
- (erc-compute-port))))))
-
- (if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input)
- (setq nick (match-string 1 user-input)
- user-input (match-string 2 user-input))
- (setq nick
- (if (erc-already-logged-in server port nick)
- (read-string
- (erc-format-message 'nick-in-use ?n nick)
- nick 'erc-nick-history-list)
- (read-string
- "Nickname: " (erc-compute-nick nick)
- 'erc-nick-history-list))))
-
- (setq server user-input)
-
- (setq passwd (if erc-prompt-for-password
- (read-passwd "Server password: ")
- (with-suppressed-warnings ((obsolete erc-password))
- erc-password)))
+ (require 'url-parse)
+ (let* ((input (let ((d (erc-compute-server)))
+ (read-string (format "Server (default is %S): " d)
+ nil 'erc-server-history-list d)))
+ ;; For legacy reasons, also accept a URL without a scheme.
+ (url (url-generic-parse-url (erc--ensure-url input)))
+ (server (url-host url))
+ (sp (and (or (string-suffix-p "s" (url-type url))
+ (and (equal server erc-default-server)
+ (not (string-prefix-p "irc://" input))))
+ 'ircs-u))
+ (port (or (url-portspec url)
+ (erc-compute-port
+ (let ((d (erc-compute-port sp))) ; may be a string
+ (read-string (format "Port (default is %s): " d)
+ nil nil d)))))
+ ;; Trust the user not to connect twice accidentally. We
+ ;; can't use `erc-already-logged-in' to check for an existing
+ ;; connection without modifying it to consider USER and PASS.
+ (nick (or (url-user url)
+ (let ((d (erc-compute-nick)))
+ (read-string (format "Nickname (default is %S): " d)
+ nil 'erc-nick-history-list d))))
+ (passwd (or (url-password url)
+ (if erc-prompt-for-password
+ (read-passwd "Server password (optional): ")
+ (with-suppressed-warnings ((obsolete erc-password))
+ erc-password)))))
(when (and passwd (string= "" passwd))
(setq passwd nil))
-
- (while (erc-already-logged-in server port nick)
- ;; hmm, this is a problem when using multiple connections to a bnc
- ;; with the same nick. Currently this code prevents using more than one
- ;; bnc with the same nick. actually it would be nice to have
- ;; bncs transparent, so that erc-compute-buffer-name displays
- ;; the server one is connected to.
- (setq nick (read-string
- (erc-format-message 'nick-in-use ?n nick)
- nick 'erc-nick-history-list)))
(list :server server :port port :nick nick :password passwd)))
;;;###autoload
@@ -2434,7 +2192,7 @@ interactively."
;;;###autoload
(cl-defun erc-tls (&key (server (erc-compute-server))
- (port (erc-compute-port))
+ (port (erc-compute-port 'ircs-u))
(nick (erc-compute-nick))
(user (erc-compute-user))
password
@@ -2749,8 +2507,7 @@ current session. `active' means the current active buffer
buffer is used. `erc-display-line-1' is used to display STRING.
If STRING is nil, the function does nothing."
- (let ((inhibit-point-motion-hooks t)
- new-bufs)
+ (let (new-bufs)
(dolist (buf (cond
((bufferp buffer) (list buffer))
((listp buffer) buffer)
@@ -2878,8 +2635,6 @@ every `erc-lurker-cleanup-interval' updates to
consumption of lurker state during long Emacs sessions and/or ERC
sessions with large numbers of incoming PRIVMSGs.")
-(defvar erc-message-parsed)
-
(defun erc-lurker-update-status (_message)
"Update `erc-lurker-state' if necessary.
@@ -3478,7 +3233,9 @@ host but different ports would result in the one with
port 123 getting
the nod. Much the same would happen for entries sharing only a port:
the one with host foo would win."
(when-let*
- ((priority (map-keys defaults))
+ ((auth-source-backend-parser-functions
+ (erc-compat--auth-source-backend-parser-functions))
+ (priority (map-keys defaults))
(test (lambda (a b)
(catch 'done
(dolist (key priority)
@@ -4055,30 +3812,42 @@ the message given by REASON."
(put 'erc-cmd-GQUIT 'do-not-parse-args t)
(put 'erc-cmd-GQUIT 'process-not-needed t)
-(defun erc-cmd-RECONNECT ()
- "Try to reconnect to the current IRC server."
+(defun erc--cmd-reconnect ()
(let ((buffer (erc-server-buffer))
(process nil))
(unless (buffer-live-p buffer)
(setq buffer (current-buffer)))
(with-current-buffer buffer
+ (when erc--server-reconnect-timer
+ (erc--cancel-auto-reconnect-timer))
(setq erc-server-quitting nil)
(with-suppressed-warnings ((obsolete erc-server-reconnecting))
(setq erc-server-reconnecting t))
- (setq erc--server-reconnecting t)
(setq erc-server-reconnect-count 0)
(setq process (get-buffer-process (erc-server-buffer)))
(when process
(delete-process process))
(erc-server-reconnect)
(with-suppressed-warnings ((obsolete erc-server-reconnecting)
- ((obsolete erc-reuse-buffers)))
+ (obsolete erc-reuse-buffers))
(if erc-reuse-buffers
(progn (cl-assert (not erc--server-reconnecting))
(cl-assert (not erc-server-reconnecting)))
(setq erc--server-reconnecting nil
erc-server-reconnecting nil)))))
t)
+
+(defun erc-cmd-RECONNECT (&rest args)
+ "Try reconnecting to the current IRC server.
+Alternatively, CANCEL a scheduled attempt for either the current
+connection or, with -A, all applicable connections.
+
+\(fn [CANCEL [-A]])"
+ (pcase args
+ (`("cancel" "-a") (erc-buffer-filter #'erc--cancel-auto-reconnect-timer))
+ (`("cancel") (erc-with-server-buffer (erc--cancel-auto-reconnect-timer)))
+ (_ (erc--cmd-reconnect))))
+
(put 'erc-cmd-RECONNECT 'process-not-needed t)
(defun erc-cmd-SERVER (server)
@@ -4091,9 +3860,6 @@ the message given by REASON."
t)
(put 'erc-cmd-SERVER 'process-not-needed t)
-(defvar motif-version-string)
-(defvar gtk-version-string)
-
(defun erc-cmd-SV ()
"Say the current ERC and Emacs version into channel."
(erc-send-message (format "I'm using ERC %s with GNU Emacs %s (%s%s)%s."
@@ -5350,6 +5116,12 @@ Example: (operator) o => @, (voiced) v => +."
(setq i (1+ i)))
alist))))
+(defcustom erc-channel-members-changed-hook nil
+ "This hook is called every time the variable `channel-members' changes.
+The buffer where the change happened is current while this hook is called."
+ :group 'erc-hooks
+ :type 'hook)
+
(defun erc-channel-receive-names (names-string)
"This function is for internal use only.
@@ -5393,13 +5165,6 @@ channel."
name name t voice halfop op admin owner)))))
(run-hooks 'erc-channel-members-changed-hook)))
-
-(defcustom erc-channel-members-changed-hook nil
- "This hook is called every time the variable `channel-members' changes.
-The buffer where the change happened is current while this hook is called."
- :group 'erc-hooks
- :type 'hook)
-
(defun erc-update-user-nick (nick &optional new-nick
host login full-name info)
"Update the stored user information for the user with nickname NICK.
@@ -6009,12 +5774,6 @@ When the returned value is a string, pass it to
`erc-error'.")
(defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$"
"Regular expression used for matching commands in ERC.")
-(cl-defstruct erc-input
- string insertp sendp)
-
-(cl-defstruct (erc--input-split (:include erc-input))
- lines cmdp)
-
(defun erc--discard-trailing-multiline-nulls (state)
"Ensure last line of STATE's string is non-null.
But only when `erc-send-whitespace-lines' is non-nil. STATE is
@@ -6654,7 +6413,7 @@ non-nil value is found.
- PORT (the argument passed to this function)
- The `erc-port' option
- The `erc-default-port' variable"
- (or port erc-port erc-default-port))
+ (erc-normalize-port (or port erc-port erc-default-port)))
;; time routines
@@ -6958,10 +6717,9 @@ shortened server name instead."
(t ""))))
;; erc-goodies is required at end of this file.
-(declare-function erc-controls-strip "erc-goodies" (str))
-
-(defvar tabbar--local-hlf)
+;; FIXME when 29.1 is cut and `format-spec' is added to ELPA Compat,
+;; remove the function invocations from the spec form below.
(defun erc-update-mode-line-buffer (buffer)
"Update the mode line in a single ERC buffer BUFFER."
(with-current-buffer buffer
@@ -6975,11 +6733,12 @@ shortened server name instead."
(?s . ,(erc-format-target-and/or-server))
(?S . ,(erc-format-target-and/or-network))
(?t . ,(erc-format-target))))
- (process-status (cond ((and (erc-server-process-alive)
- (not erc-server-connected))
- ":connecting")
- ((erc-server-process-alive)
- "")
+ (process-status (cond ((erc-server-process-alive buffer)
+ (unless erc-server-connected
+ ": connecting"))
+ ((erc-with-server-buffer
+ erc--server-reconnect-timer)
+ erc--mode-line-process-reconnecting)
(t
": CLOSED")))
(face (cond ((eq erc-header-line-face-method nil)
@@ -6990,7 +6749,7 @@ shortened server name instead."
'erc-header-line))))
(setq mode-line-buffer-identification
(list (format-spec erc-mode-line-format spec)))
- (setq mode-line-process (list process-status))
+ (setq mode-line-process process-status)
(let ((header (if erc-header-line-format
(format-spec erc-header-line-format spec)
nil)))
@@ -7175,6 +6934,8 @@ All windows are opened in the current frame."
(disconnected . "\n\nConnection failed! Re-establishing connection...\n")
(disconnected-noreconnect
. "\n\nConnection failed! Not re-establishing connection.\n")
+ (reconnecting . "Reconnecting in %ms: attempt %i/%n ...")
+ (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...")
(finished . "\n\n*** ERC finished ***\n")
(terminated . "\n\n*** ERC terminated: %e\n")
(login . "Logging in as `%n'...")
@@ -7326,7 +7087,7 @@ See also `format-spec'."
(error "No format spec for message %s" msg))
(when (functionp entry)
(setq entry (apply entry args)))
- (format-spec entry (apply #'format-spec-make args))))
+ (format-spec entry (apply #'format-spec-make args) 'ignore)))
;;; Various hook functions
@@ -7425,34 +7186,84 @@ This function should be on `erc-kill-channel-hook'."
;; Teach url.el how to open irc:// URLs with ERC.
;; To activate, customize `url-irc-function' to `url-irc-erc'.
-;; FIXME change user to nick, and use API to find server buffer
+(defcustom erc-url-connect-function nil
+ "When non-nil, a function used to connect to an IRC URL.
+Called with a string meant to represent a URL scheme, like
+\"ircs\", followed by any number of keyword arguments recognized
+by `erc' and `erc-tls'."
+ :group 'erc
+ :package-version '(ERC . "5.4.1") ; FIXME increment on release
+ :type '(choice (const nil) function))
+
+(defun erc--url-default-connect-function (scheme &rest plist)
+ (let* ((ircsp (if scheme
+ (string-suffix-p "s" scheme)
+ (or (eql 6697 (plist-get plist :port))
+ (yes-or-no-p "Connect using TLS? "))))
+ (erc-server (plist-get plist :server))
+ (erc-port (or (plist-get plist :port)
+ (and ircsp (erc-normalize-port 'ircs-u))
+ erc-port))
+ (erc-nick (or (plist-get plist :nick) erc-nick))
+ (erc-password (plist-get plist :password))
+ (args (erc-select-read-args)))
+ (unless ircsp
+ (setq ircsp (eql 6697 erc-port)))
+ (apply (if ircsp #'erc-tls #'erc) args)))
+
;;;###autoload
-(defun erc-handle-irc-url (host port channel user password)
- "Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
+(defun erc-handle-irc-url (host port channel nick password &optional scheme)
+ "Use ERC to IRC on HOST:PORT in CHANNEL.
If ERC is already connected to HOST:PORT, simply /join CHANNEL.
-Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
- (let ((server-buffer
- (car (erc-buffer-filter
- (lambda ()
- (and (string-equal erc-session-server host)
- (= erc-session-port port)
- (erc-open-server-buffer-p)))))))
- (with-current-buffer (or server-buffer (current-buffer))
- (if (and server-buffer channel)
- (erc-cmd-JOIN channel)
- (erc-open host port (or user (erc-compute-nick))
(erc-compute-full-name)
- (not server-buffer) password nil channel
- (when server-buffer
- (get-buffer-process server-buffer)))))))
+Otherwise, connect to HOST:PORT as NICK and /join CHANNEL.
+
+Beginning with ERC 5.5, new connections require human intervention.
+Customize `erc-url-connect-function' to override this."
+ (when (eql port 0) (setq port nil))
+ (let* ((net (erc-networks--determine host))
+ (server-buffer
+ ;; Viable matches may slip through the cracks for unknown
+ ;; networks. Additional passes could likely improve things.
+ (car (erc-buffer-filter
+ (lambda ()
+ (and (not erc--target)
+ (erc-server-process-alive)
+ ;; Always trust a matched network.
+ (or (and net (eq net (erc-network)))
+ (and (string-equal erc-session-server host)
+ ;; Ports only matter when dialed hosts
+ ;; match and we have sufficient info.
+ (or (not port)
+ (= (erc-normalize-port erc-session-port)
+ port)))))))))
+ key deferred)
+ (unless server-buffer
+ (setq deferred t
+ server-buffer (apply (or erc-url-connect-function
+ #'erc--url-default-connect-function)
+ scheme
+ :server host
+ `(,@(and port (list :port port))
+ ,@(and nick (list :nick nick))
+ ,@(and password `(:password ,password))))))
+ (when channel
+ ;; These aren't percent-decoded by default
+ (when (string-prefix-p "%" channel)
+ (setq channel (url-unhex-string channel)))
+ (cl-multiple-value-setq (channel key) (split-string channel "[?]"))
+ (if deferred
+ ;; Alternatively, we could make this a defmethod, so when
+ ;; autojoin is loaded, it can do its own thing. Also, as
+ ;; with `erc-once-with-server-event', it's fine to set local
+ ;; hooks here because they're killed when reconnecting.
+ (with-current-buffer server-buffer
+ (letrec ((f (lambda (&rest _)
+ (remove-hook 'erc-after-connect f t)
+ (erc-cmd-JOIN channel key))))
+ (add-hook 'erc-after-connect f nil t)))
+ (with-current-buffer server-buffer
+ (erc-cmd-JOIN channel key))))))
(provide 'erc)
-(require 'erc-backend)
-
-;; Deprecated. We might eventually stop requiring the goodies automatically.
-;; IMPORTANT: This require must appear _after_ the above (provide 'erc) to
-;; avoid a recursive require error when byte-compiling the entire package.
-(require 'erc-goodies)
-(require 'erc-networks)
-
;;; erc.el ends here
diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el
index a1a91e7d63..a8744de1db 100644
--- a/lisp/eshell/em-prompt.el
+++ b/lisp/eshell/em-prompt.el
@@ -100,6 +100,14 @@ arriving, or after."
"C-c C-n" #'eshell-next-prompt
"C-c C-p" #'eshell-previous-prompt)
+(defvar-keymap eshell-prompt-repeat-map
+ :doc "Keymap to repeat eshell-prompt key sequences. Used in `repeat-mode'."
+ "C-n" #'eshell-next-prompt
+ "C-p" #'eshell-previous-prompt)
+
+(put #'eshell-next-prompt 'repeat-map 'eshell-prompt-repeat-map)
+(put #'eshell-previous-prompt 'repeat-map 'eshell-prompt-repeat-map)
+
;;; Functions:
(define-minor-mode eshell-prompt-mode
diff --git a/lisp/eshell/em-script.el b/lisp/eshell/em-script.el
index e0bcd8b099..06ddda1424 100644
--- a/lisp/eshell/em-script.el
+++ b/lisp/eshell/em-script.el
@@ -90,8 +90,7 @@ This includes when running `eshell-command'."
"Execute a series of Eshell commands in FILE, passing ARGS.
Comments begin with `#'."
(let ((orig (point))
- (here (point-max))
- (inhibit-point-motion-hooks t))
+ (here (point-max)))
(goto-char (point-max))
(with-silent-modifications
;; FIXME: Why not use a temporary buffer and avoid this
diff --git a/lisp/eshell/em-smart.el b/lisp/eshell/em-smart.el
index 6768cee4c3..c52ce31899 100644
--- a/lisp/eshell/em-smart.el
+++ b/lisp/eshell/em-smart.el
@@ -197,8 +197,7 @@ The options are `begin', `after' or `end'."
(defun eshell-smart-scroll-window (wind _start)
"Scroll the given Eshell window WIND accordingly."
(unless eshell-currently-handling-window
- (let ((inhibit-point-motion-hooks t)
- (eshell-currently-handling-window t))
+ (let ((eshell-currently-handling-window t))
(with-selected-window wind
(eshell-smart-redisplay)))))
diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el
index aebbc36e71..499deaa7fc 100644
--- a/lisp/eshell/em-tramp.el
+++ b/lisp/eshell/em-tramp.el
@@ -1,4 +1,4 @@
-;;; em-tramp.el --- Eshell features that require TRAMP -*- lexical-binding:t
-*-
+;;; em-tramp.el --- Eshell features that require Tramp -*- lexical-binding:t
-*-
;; Copyright (C) 1999-2022 Free Software Foundation, Inc.
@@ -21,7 +21,7 @@
;;; Commentary:
-;; Eshell features that require TRAMP.
+;; Eshell features that require Tramp.
;;; Code:
@@ -38,29 +38,30 @@
;;;###autoload
(progn
(defgroup eshell-tramp nil
- "This module defines commands that use TRAMP in a way that is
+ "This module defines commands that use Tramp in a way that is
not transparent to the user. So far, this includes only the
- built-in su and sudo commands, which are not compatible with
- the full, external su and sudo commands, and require the user
- to understand how to use the TRAMP sudo method."
- :tag "TRAMP Eshell features"
+ built-in su, sudo and doas commands, which are not compatible
+ with the full, external su, sudo, and doas commands, and
+ require the user to understand how to use the Tramp sudo
+ method."
+ :tag "Tramp Eshell features"
:group 'eshell-module))
(defun eshell-tramp-initialize () ;Called from `eshell-mode' via intern-soft!
- "Initialize the TRAMP-using commands code."
+ "Initialize the Tramp-using commands code."
(when (eshell-using-module 'eshell-cmpl)
(add-hook 'pcomplete-try-first-hook
'eshell-complete-host-reference nil t))
(setq-local eshell-complex-commands
- (append '("su" "sudo")
+ (append '("su" "sudo" "doas")
eshell-complex-commands)))
(autoload 'eshell-parse-command "esh-cmd")
(defun eshell/su (&rest args)
- "Alias \"su\" to call TRAMP.
+ "Alias \"su\" to call Tramp.
-Uses the system su through TRAMP's su method."
+Uses the system su through Tramp's su method."
(eshell-eval-using-options
"su" args
'((?h "help" nil nil "show this usage screen")
@@ -91,42 +92,67 @@ Become another USER during a login session.")
(put 'eshell/su 'eshell-no-numeric-conversions t)
+(defun eshell--method-wrap-directory (directory method &optional user)
+ "Return DIRECTORY as accessed by a Tramp METHOD for USER."
+ (let ((user (or user "root"))
+ (dir (file-local-name (expand-file-name directory)))
+ (prefix (file-remote-p directory))
+ (host (or (file-remote-p directory 'host)
+ tramp-default-host))
+ (rmethod (file-remote-p directory 'method))
+ (ruser (file-remote-p directory 'user)))
+ (if (and prefix (or (not (string-equal rmethod method))
+ (not (string-equal ruser user))))
+ (format "%s|%s:%s@%s:%s"
+ (substring prefix 0 -1) method user host dir)
+ (format "/%s:%s@%s:%s" method user host dir))))
+
(defun eshell/sudo (&rest args)
"Alias \"sudo\" to call Tramp.
-Uses the system sudo through TRAMP's sudo method."
+Uses the system sudo through Tramp's sudo method."
(eshell-eval-using-options
"sudo" args
'((?h "help" nil nil "show this usage screen")
(?u "user" t user "execute a command as another USER")
+ (?s "shell" nil shell "start a shell instead of executing COMMAND")
:show-usage
:parse-leading-options-only
- :usage "[(-u | --user) USER] COMMAND
+ :usage "[(-u | --user) USER] (-s | --shell) | COMMAND
Execute a COMMAND as the superuser or another USER.")
- (throw 'eshell-external
- (let* ((user (or user "root"))
- (host (or (file-remote-p default-directory 'host)
- tramp-default-host))
- (dir (file-local-name (expand-file-name default-directory)))
- (prefix (file-remote-p default-directory))
- (default-directory
- (if (and prefix
- (or
- (not
- (string-equal
- "sudo"
- (file-remote-p default-directory 'method)))
- (not
- (string-equal
- user
- (file-remote-p default-directory 'user)))))
- (format "%s|sudo:%s@%s:%s"
- (substring prefix 0 -1) user host dir)
- (format "/sudo:%s@%s:%s" user host dir))))
- (eshell-named-command (car args) (cdr args))))))
+ (let ((dir (eshell--method-wrap-directory default-directory "sudo" user)))
+ (if shell
+ (throw 'eshell-replace-command
+ (eshell-parse-command "cd" (list dir)))
+ (throw 'eshell-external
+ (let ((default-directory dir))
+ (eshell-named-command (car args) (cdr args))))))))
(put 'eshell/sudo 'eshell-no-numeric-conversions t)
+(defun eshell/doas (&rest args)
+ "Call Tramp's doas method with ARGS.
+
+Uses the system doas through Tramp's doas method."
+ (eshell-eval-using-options
+ "doas" args
+ '((?h "help" nil nil "show this usage screen")
+ (?u "user" t user "execute a command as another USER")
+ (?s "shell" nil shell "start a shell instead of executing COMMAND")
+ :show-usage
+ :parse-leading-options-only
+ :usage "[(-u | --user) USER] (-s | --shell) | COMMAND
+Execute a COMMAND as the superuser or another USER.")
+ (let ((dir (eshell--method-wrap-directory default-directory "doas" user)))
+ (if shell
+ (throw 'eshell-replace-command
+ (eshell-parse-command "cd" (list dir)))
+ (throw 'eshell-external
+ (let ((default-directory dir))
+ (eshell-named-command (car args) (cdr args))))))))
+
+(put 'eshell/doas 'eshell-no-numeric-conversions t)
+
(provide 'em-tramp)
;; Local Variables:
diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el
index 40b83010f9..4b5e4dd53e 100644
--- a/lisp/eshell/em-unix.el
+++ b/lisp/eshell/em-unix.el
@@ -372,12 +372,10 @@ Remove the DIRECTORY(ies), if they are empty.")
(setq attr (eshell-file-attributes (car files)))
(file-attribute-inode-number attr-target)
(file-attribute-inode-number attr)
- (equal (file-attribute-inode-number attr-target)
- (file-attribute-inode-number attr))
(file-attribute-device-number attr-target)
(file-attribute-device-number attr)
- (equal (file-attribute-device-number attr-target)
- (file-attribute-device-number attr)))
+ (equal (file-attribute-file-identifier attr-target)
+ (file-attribute-file-identifier attr)))
(eshell-error (format-message "%s: `%s' and `%s' are the same file\n"
command (car files) target)))
(t
diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el
index 576d32b8c5..f87cc2f20a 100644
--- a/lisp/eshell/esh-arg.el
+++ b/lisp/eshell/esh-arg.el
@@ -285,8 +285,7 @@ Point is left at the end of the arguments."
(save-restriction
(goto-char beg)
(narrow-to-region beg end)
- (let ((inhibit-point-motion-hooks t)
- (args (list t))
+ (let ((args (list t))
delim)
(with-silent-modifications
(remove-text-properties (point-min) (point-max)
diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el
index 413336e3eb..4a41bbe8fa 100644
--- a/lisp/eshell/esh-cmd.el
+++ b/lisp/eshell/esh-cmd.el
@@ -261,9 +261,9 @@ the command."
(defcustom eshell-subcommand-bindings
'((eshell-in-subcommand-p t)
(eshell-in-pipeline-p nil)
- (default-directory default-directory)
- (process-environment (eshell-copy-environment)))
+ (default-directory default-directory))
"A list of `let' bindings for subcommand environments."
+ :version "29.1" ; removed `process-environment'
:type 'sexp
:risky t)
@@ -372,8 +372,7 @@ The value returned is the last form in BODY."
;; Since parsing relies partly on buffer-local state
;; (e.g. that of `eshell-parse-argument-hook'), we need to
;; perform the parsing in the Eshell buffer.
- (let ((begin (point)) end
- (inhibit-point-motion-hooks t))
+ (let ((begin (point)) end)
(with-silent-modifications
(insert reg)
(setq end (point))
@@ -1275,8 +1274,9 @@ be finished later after the completion of an asynchronous
subprocess."
name)
(eshell-search-path name)))))
(if (not program)
- (eshell-error (format "which: no %s in (%s)\n"
- name (getenv "PATH")))
+ (eshell-error (format "which: no %s in (%s)\n"
+ name (string-join (eshell-get-path t)
+ (path-separator))))
(eshell-printn program)))))
(put 'eshell/which 'eshell-no-numeric-conversions t)
diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el
index 98902fc6f2..d513d750d9 100644
--- a/lisp/eshell/esh-ext.el
+++ b/lisp/eshell/esh-ext.el
@@ -77,7 +77,7 @@ but Eshell will be able to understand
(let ((list (eshell-get-path))
suffixes n1 n2 file)
(while list
- (setq n1 (concat (car list) name))
+ (setq n1 (file-name-concat (car list) name))
(setq suffixes eshell-binary-suffixes)
(while suffixes
(setq n2 (concat n1 (car suffixes)))
@@ -239,17 +239,16 @@ causing the user to wonder if anything's really going
on..."
(?h "help" nil nil "display this usage message")
:usage "[-b] PATH
Adds the given PATH to $PATH.")
- (if args
- (progn
- (setq eshell-path-env (getenv "PATH")
- args (mapconcat #'identity args path-separator)
- eshell-path-env
- (if prepend
- (concat args path-separator eshell-path-env)
- (concat eshell-path-env path-separator args)))
- (setenv "PATH" eshell-path-env))
- (dolist (dir (parse-colon-path (getenv "PATH")))
- (eshell-printn dir)))))
+ (let ((path (eshell-get-path t)))
+ (if args
+ (progn
+ (setq path (if prepend
+ (append args path)
+ (append path args)))
+ (eshell-set-path path)
+ (string-join path (path-separator)))
+ (dolist (dir path)
+ (eshell-printn dir))))))
(put 'eshell/addpath 'eshell-no-numeric-conversions t)
(put 'eshell/addpath 'eshell-filename-arguments t)
diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el
index 8f11e6f04a..4357a0e29a 100644
--- a/lisp/eshell/esh-mode.el
+++ b/lisp/eshell/esh-mode.el
@@ -280,6 +280,14 @@ This is used by `eshell-watch-for-password-prompt'."
"C-w" #'backward-kill-word
"C-y" #'eshell-repeat-argument)
+(defvar-keymap eshell-command-repeat-map
+ :doc "Keymap to repeat eshell-command key sequences. Used in `repeat-mode'."
+ "C-f" #'eshell-forward-argument
+ "C-b" #'eshell-backward-argument)
+
+(put #'eshell-forward-argument 'repeat-map 'eshell-command-repeat-map)
+(put #'eshell-backward-argument 'repeat-map 'eshell-command-repeat-map)
+
;;; User Functions:
(defun eshell-kill-buffer-function ()
@@ -598,7 +606,6 @@ newline."
;; Note that the input string does not include its terminal newline.
(let ((proc-running-p (and (eshell-head-process)
(not queue-p)))
- (inhibit-point-motion-hooks t)
(inhibit-modification-hooks t))
(unless (and proc-running-p
(not (eq (process-status
@@ -687,7 +694,6 @@ newline."
This is done after all necessary filtering has been done."
(let ((oprocbuf (if process (process-buffer process)
(current-buffer)))
- (inhibit-point-motion-hooks t)
(inhibit-modification-hooks t))
(when (and string oprocbuf (buffer-name oprocbuf))
(with-current-buffer oprocbuf
diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el
index 7e005a0fc1..950922ea7f 100644
--- a/lisp/eshell/esh-proc.el
+++ b/lisp/eshell/esh-proc.el
@@ -277,7 +277,23 @@ Used only on systems which do not support async
subprocesses.")
eshell-delete-exited-processes
delete-exited-processes))
(process-environment (eshell-environment-variables))
+ (coding-system-for-read coding-system-for-read)
+ (coding-system-for-write coding-system-for-write)
proc stderr-proc decoding encoding changed)
+ ;; MS-Windows needs special setting of encoding/decoding, because
+ ;; (a) non-ASCII text in command-line arguments needs to be
+ ;; encoded in the system's codepage; and (b) because many Windows
+ ;; programs will always interpret any non-ASCII input as encoded
+ ;; in the system codepage.
+ (when (eq system-type 'windows-nt)
+ (or coding-system-for-read ; Honor manual decoding settings
+ (setq coding-system-for-read
+ (coding-system-change-eol-conversion locale-coding-system
+ 'dos)))
+ (or coding-system-for-write ; Honor manual encoding settings
+ (setq coding-system-for-write
+ (coding-system-change-eol-conversion locale-coding-system
+ 'unix))))
(cond
((fboundp 'make-process)
(unless (equal (car (aref eshell-current-handles eshell-output-handle))
@@ -325,7 +341,7 @@ Used only on systems which do not support async
subprocesses.")
(setq decoding (coding-system-change-eol-conversion decoding 'dos)
changed t))
;; Even if `make-process' left the coding system for encoding
- ;; data sent from the process undecided, we had better use the
+ ;; data sent to the process undecided, we had better use the
;; same one as what we use for decoding. But, we should
;; suppress EOL conversion.
(if (and decoding (not encoding))
@@ -536,7 +552,7 @@ See the variable `eshell-kill-processes-on-exit'."
(setq sigs (cdr sigs))))))
(defun eshell-query-kill-processes ()
- "Kill processes belonging to the current Eshell buffer, possibly w/ query."
+ "Kill processes belonging to the current Eshell buffer, possibly with query."
(when (and eshell-kill-processes-on-exit
eshell-process-list)
(save-window-excursion
diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el
index 9258ca5e40..0ec11e8a0b 100644
--- a/lisp/eshell/esh-util.el
+++ b/lisp/eshell/esh-util.el
@@ -249,17 +249,60 @@ trailing newlines removed. Otherwise, this behaves as
follows:
It might be different from \(getenv \"PATH\"), when
`default-directory' points to a remote host.")
-(defun eshell-get-path ()
+(make-obsolete-variable 'eshell-path-env 'eshell-get-path "29.1")
+
+(defvar-local eshell-path-env-list nil)
+
+(connection-local-set-profile-variables
+ 'eshell-connection-default-profile
+ '((eshell-path-env-list . nil)))
+
+(connection-local-set-profiles
+ '(:application eshell)
+ 'eshell-connection-default-profile)
+
+(defun eshell-get-path (&optional literal-p)
"Return $PATH as a list.
-Add the current directory on MS-Windows."
- (eshell-parse-colon-path
- (if (eshell-under-windows-p)
- (concat "." path-separator eshell-path-env)
- eshell-path-env)))
+If LITERAL-P is nil, return each directory of the path as a full,
+possibly-remote file name; on MS-Windows, add the current
+directory as the first directory in the path as well.
+
+If LITERAL-P is non-nil, return the local part of each directory,
+as the $PATH was actually specified."
+ (with-connection-local-application-variables 'eshell
+ (let ((remote (file-remote-p default-directory))
+ (path
+ (or eshell-path-env-list
+ ;; If not already cached, get the path from
+ ;; `exec-path', removing the last element, which is
+ ;; `exec-directory'.
+ (setq-connection-local eshell-path-env-list
+ (butlast (exec-path))))))
+ (when (and (not literal-p)
+ (not remote)
+ (eshell-under-windows-p))
+ (push "." path))
+ (if (and remote (not literal-p))
+ (mapcar (lambda (x) (file-name-concat remote x)) path)
+ path))))
+
+(defun eshell-set-path (path)
+ "Set the Eshell $PATH to PATH.
+PATH can be either a list of directories or a string of
+directories separated by `path-separator'."
+ (with-connection-local-application-variables 'eshell
+ (setq-connection-local
+ eshell-path-env-list
+ (if (listp path)
+ path
+ ;; Don't use `parse-colon-path' here, since we don't want
+ ;; the additional translations it does on each element.
+ (split-string path (path-separator))))))
(defun eshell-parse-colon-path (path-env)
"Split string with `parse-colon-path'.
Prepend remote identification of `default-directory', if any."
+ (declare (obsolete nil "29.1"))
(let ((remote (file-remote-p default-directory)))
(if remote
(mapcar
@@ -307,16 +350,13 @@ Prepend remote identification of `default-directory', if
any."
"Convert OBJECT into a string value."
(cond
((stringp object) object)
- ((and (listp object)
- (not (eq object nil)))
- (let ((string (pp-to-string object)))
- (substring string 0 (1- (length string)))))
((numberp object)
(number-to-string object))
+ ((and (eq object t)
+ (not eshell-stringify-t))
+ nil)
(t
- (unless (and (eq object t)
- (not eshell-stringify-t))
- (pp-to-string object)))))
+ (string-trim-right (pp-to-string object)))))
(defsubst eshell-stringify-list (args)
"Convert each element of ARGS into a string value."
@@ -412,7 +452,7 @@ list."
;; runs while point is in the minibuffer and the users attempt
;; to use completion. Don't ask me.
(condition-case nil
- (sit-for 0 0)
+ (sit-for 0)
(error nil)))
(defun eshell-read-passwd-file (file)
diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el
index 36e59cd5a4..57ea42f493 100644
--- a/lisp/eshell/esh-var.el
+++ b/lisp/eshell/esh-var.el
@@ -113,7 +113,7 @@
(require 'pcomplete)
(require 'ring)
-(defconst eshell-inside-emacs (format "%s,eshell" emacs-version)
+(defvar-local eshell-inside-emacs (format "%s,eshell" emacs-version)
"Value for the `INSIDE_EMACS' environment variable.")
(defgroup eshell-var nil
@@ -156,14 +156,21 @@ if they are quoted with a backslash."
("LINES" ,(lambda () (window-body-height nil 'remap)) t t)
("INSIDE_EMACS" eshell-inside-emacs t)
- ;; for eshell-cmd.el
+ ;; for esh-ext.el
+ ("PATH" (,(lambda () (string-join (eshell-get-path t) (path-separator)))
+ . ,(lambda (_ value)
+ (eshell-set-path value)
+ value))
+ t t)
+
+ ;; for esh-cmd.el
("_" ,(lambda (indices quoted)
(if (not indices)
(car (last eshell-last-arguments))
(eshell-apply-indices eshell-last-arguments
indices quoted))))
- ("?" eshell-last-command-status)
- ("$" eshell-last-command-result)
+ ("?" (eshell-last-command-status . nil))
+ ("$" (eshell-last-command-result . nil))
;; for em-alias.el and em-script.el
("0" eshell-command-name)
@@ -176,7 +183,7 @@ if they are quoted with a backslash."
("7" ,(lambda () (nth 6 eshell-command-arguments)) nil t)
("8" ,(lambda () (nth 7 eshell-command-arguments)) nil t)
("9" ,(lambda () (nth 8 eshell-command-arguments)) nil t)
- ("*" eshell-command-arguments))
+ ("*" (eshell-command-arguments . nil)))
"This list provides aliasing for variable references.
Each member is of the following form:
@@ -186,6 +193,11 @@ NAME defines the name of the variable, VALUE is a Lisp
value used to
compute the string value that will be returned when the variable is
accessed via the syntax `$NAME'.
+If VALUE is a cons (GET . SET), then variable references to NAME
+will use GET to get the value, and SET to set it. GET and SET
+can be one of the forms described below. If SET is nil, the
+variable is read-only.
+
If VALUE is a function, its behavior depends on the value of
SIMPLE-FUNCTION. If SIMPLE-FUNCTION is nil, call VALUE with two
arguments: the list of the indices that were used in the reference,
@@ -193,23 +205,30 @@ and either t or nil depending on whether or not the
variable was
quoted with double quotes. For example, if `NAME' were aliased
to a function, a reference of `$NAME[10][20]' would result in that
function being called with the arguments `((\"10\") (\"20\"))' and
-nil.
-If SIMPLE-FUNCTION is non-nil, call the function with no arguments
-and then pass its return value to `eshell-apply-indices'.
+nil. If SIMPLE-FUNCTION is non-nil, call the function with no
+arguments and then pass its return value to `eshell-apply-indices'.
+
+When VALUE is a function, it's read-only by default. To make it
+writeable, use the (GET . SET) form described above. If SET is a
+function, it takes two arguments: a list of indices (currently
+always nil, but reserved for future enhancement), and the new
+value to set.
-If VALUE is a string, return the value for the variable with that
-name in the current environment. If no variable with that name exists
-in the environment, but if a symbol with that same name exists and has
-a value bound to it, return that symbol's value instead. You can
-prefer symbol values over environment values by setting the value
-of `eshell-prefer-lisp-variables' to t.
+If VALUE is a string, get/set the value for the variable with
+that name in the current environment. When getting the value, if
+no variable with that name exists in the environment, but if a
+symbol with that same name exists and has a value bound to it,
+return that symbol's value instead. You can prefer symbol values
+over environment values by setting the value of
+`eshell-prefer-lisp-variables' to t.
-If VALUE is a symbol, return the value bound to it.
+If VALUE is a symbol, get/set the value bound to it.
If VALUE has any other type, signal an error.
Additionally, if COPY-TO-ENVIRONMENT is non-nil, the alias should be
copied (a.k.a. \"exported\") to the environment of created subprocesses."
+ :version "29.1"
:type '(repeat (list string sexp
(choice (const :tag "Copy to environment" t)
(const :tag "Use only in Eshell" nil))
@@ -234,6 +253,12 @@ copied (a.k.a. \"exported\") to the environment of created
subprocesses."
;; changing a variable will affect all of Emacs.
(unless eshell-modify-global-environment
(setq-local process-environment (eshell-copy-environment)))
+ (setq-local eshell-subcommand-bindings
+ (append
+ '((process-environment (eshell-copy-environment))
+ (eshell-variable-aliases-list eshell-variable-aliases-list)
+ (eshell-path-env-list eshell-path-env-list))
+ eshell-subcommand-bindings))
(setq-local eshell-special-chars-inside-quoting
(append eshell-special-chars-inside-quoting '(?$)))
@@ -282,9 +307,9 @@ copied (a.k.a. \"exported\") to the environment of created
subprocesses."
(while (string-match setvar command)
(nconc
l (list
- (list 'setenv (match-string 1 command)
- (match-string 2 command)
- (= (length (match-string 2 command)) 0))))
+ (list 'eshell-set-variable
+ (match-string 1 command)
+ (match-string 2 command))))
(setq command (eshell-stringify (car args))
args (cdr args)))
(cdr l))
@@ -302,6 +327,11 @@ This function is explicit for adding to
`eshell-parse-argument-hook'."
(defun eshell/define (var-alias definition)
"Define a VAR-ALIAS using DEFINITION."
+ ;; FIXME: This function doesn't work (it produces variable aliases
+ ;; in a form not recognized by other parts of the code), and likely
+ ;; hasn't worked since before its introduction into Emacs. It
+ ;; should either be removed or fixed up.
+ (declare (obsolete nil "29.1"))
(if (not definition)
(setq eshell-variable-aliases-list
(delq (assoc var-alias eshell-variable-aliases-list)
@@ -323,12 +353,11 @@ This function is explicit for adding to
`eshell-parse-argument-hook'."
(defun eshell/export (&rest sets)
"This alias allows the `export' command to act as bash users expect."
- (while sets
- (if (and (stringp (car sets))
- (string-match "^\\([^=]+\\)=\\(.*\\)" (car sets)))
- (setenv (match-string 1 (car sets))
- (match-string 2 (car sets))))
- (setq sets (cdr sets))))
+ (dolist (set sets)
+ (when (and (stringp set)
+ (string-match "^\\([^=]+\\)=\\(.*\\)" set))
+ (eshell-set-variable (match-string 1 set)
+ (match-string 2 set)))))
(defun pcomplete/eshell-mode/export ()
"Completion function for Eshell's `export'."
@@ -338,16 +367,28 @@ This function is explicit for adding to
`eshell-parse-argument-hook'."
(eshell-envvar-names)))))
(defun eshell/unset (&rest args)
- "Unset an environment variable."
- (while args
- (if (stringp (car args))
- (setenv (car args) nil t))
- (setq args (cdr args))))
+ "Unset one or more variables.
+This is equivalent to calling `eshell/set' for all of ARGS with
+the values of nil for each."
+ (dolist (arg args)
+ (eshell-set-variable arg nil)))
(defun pcomplete/eshell-mode/unset ()
"Completion function for Eshell's `unset'."
(while (pcomplete-here (eshell-envvar-names))))
+(defun eshell/set (&rest args)
+ "Allow command-ish use of `set'."
+ (let (last-value)
+ (while args
+ (setq last-value (eshell-set-variable (car args) (cadr args))
+ args (cddr args)))
+ last-value))
+
+(defun pcomplete/eshell-mode/set ()
+ "Completion function for Eshell's `set'."
+ (while (pcomplete-here (eshell-envvar-names))))
+
(defun eshell/setq (&rest args)
"Allow command-ish use of `setq'."
(let (last-value)
@@ -561,18 +602,21 @@ INDICES is a list of index-lists (see
`eshell-parse-indices').
If QUOTED is non-nil, this was invoked inside double-quotes."
(if-let ((alias (assoc name eshell-variable-aliases-list)))
(let ((target (nth 1 alias)))
+ (when (and (not (functionp target))
+ (consp target))
+ (setq target (car target)))
(cond
((functionp target)
(if (nth 3 alias)
(eshell-apply-indices (funcall target) indices quoted)
- (condition-case nil
- (funcall target indices quoted)
- (wrong-number-of-arguments
- (display-warning
- :warning (concat "Function for `eshell-variable-aliases-list' "
- "entry should accept two arguments: INDICES "
- "and QUOTED.'"))
- (funcall target indices)))))
+ (let ((max-arity (cdr (func-arity target))))
+ (if (or (eq max-arity 'many) (>= max-arity 2))
+ (funcall target indices quoted)
+ (display-warning
+ :warning (concat "Function for `eshell-variable-aliases-list'
"
+ "entry should accept two arguments: INDICES "
+ "and QUOTED.'"))
+ (funcall target indices)))))
((symbolp target)
(eshell-apply-indices (symbol-value target) indices quoted))
(t
@@ -589,6 +633,44 @@ If QUOTED is non-nil, this was invoked inside
double-quotes."
(getenv name)))
indices quoted)))
+(defun eshell-set-variable (name value)
+ "Set the variable named NAME to VALUE.
+NAME can be a string (in which case it refers to an environment
+variable or variable alias) or a symbol (in which case it refers
+to a Lisp variable)."
+ (if-let ((alias (assoc name eshell-variable-aliases-list)))
+ (let ((target (nth 1 alias)))
+ (cond
+ ((functionp target)
+ (setq target nil))
+ ((consp target)
+ (setq target (cdr target))))
+ (cond
+ ((functionp target)
+ (funcall target nil value))
+ ((null target)
+ (unless eshell-in-subcommand-p
+ (error "Variable `%s' is not settable" (eshell-stringify name)))
+ (push `(,name ,(lambda () value) t t)
+ eshell-variable-aliases-list)
+ value)
+ ;; Since getting a variable alias with a string target and
+ ;; `eshell-prefer-lisp-variables' non-nil gets the
+ ;; corresponding Lisp variable, make sure setting does the
+ ;; same.
+ ((and eshell-prefer-lisp-variables
+ (stringp target))
+ (eshell-set-variable (intern target) value))
+ (t
+ (eshell-set-variable target value))))
+ (cond
+ ((stringp name)
+ (setenv name value))
+ ((symbolp name)
+ (set name value))
+ (t
+ (error "Unknown variable `%s'" (eshell-stringify name))))))
+
(defun eshell-apply-indices (value indices &optional quoted)
"Apply to VALUE all of the given INDICES, returning the sub-result.
The format of INDICES is:
diff --git a/lisp/face-remap.el b/lisp/face-remap.el
index 432385587b..a692015094 100644
--- a/lisp/face-remap.el
+++ b/lisp/face-remap.el
@@ -367,7 +367,7 @@ See `text-scale-increase' for more details."
;;;###autoload
(defun text-scale-adjust (inc)
"Adjust the font size in the current buffer by INC steps.
-INC may be passed as a numeric prefix argument.
+Interactively, INC is the prefix numeric argument, and defaults to 1.
The actual adjustment made depends on the final component of the
keybinding used to invoke the command, with all modifiers removed:
@@ -377,13 +377,14 @@ keybinding used to invoke the command, with all modifiers
removed:
\\`0' Reset the font size to the global default
After adjusting, continue to read input events and further adjust
-the font size as long as the input event read
-\(with all modifiers removed) is one of the above characters.
+the font size as long as the input event (with all modifiers removed)
+is one of the above characters.
-Each step scales the height of the default face by the variable
-`text-scale-mode-step' (a negative number of steps decreases the
-height by the same amount). As a special case, an argument of 0
-will remove any scaling currently active.
+Each step scales the height of the default face by the factor that
+is the value of `text-scale-mode-step' (a negative number of steps
+decreases the height by that factor). As a special case, an argument
+of 0 will remove any scaling currently active, thus resetting the
+font size to the original value.
This command is a special-purpose wrapper around the
`text-scale-increase' command which makes repetition convenient
@@ -396,7 +397,11 @@ that have an explicit `:height' setting. The two
exceptions to
this are the `default' and `header-line' faces: they will both be
scaled even if they have an explicit `:height' setting.
-See also the related command `global-text-scale-adjust'."
+See also the related command `global-text-scale-adjust'. Unlike
+that command, which scales the font size with a increment,
+`text-scale-adjust' scales the font size with a factor,
+`text-scale-mode-step'. With a small `text-scale-mode-step'
+factor, the two commands behave similarly."
(interactive "p")
(let ((ev last-command-event)
(echo-keystrokes nil))
@@ -461,25 +466,30 @@ the `cdr' has the maximum font size, in units of 1/10 pt."
(defvar global-text-scale-adjust--default-height nil)
+(defvar global-text-scale-adjust--increment-factor 5)
+
;;;###autoload (define-key ctl-x-map [(control meta ?+)]
'global-text-scale-adjust)
;;;###autoload (define-key ctl-x-map [(control meta ?=)]
'global-text-scale-adjust)
;;;###autoload (define-key ctl-x-map [(control meta ?-)]
'global-text-scale-adjust)
;;;###autoload (define-key ctl-x-map [(control meta ?0)]
'global-text-scale-adjust)
;;;###autoload
(defun global-text-scale-adjust (increment)
- "Globally adjust the font size by INCREMENT.
+ "Change (a.k.a. \"adjust\") the font size of all faces by INCREMENT.
-Interactively, INCREMENT may be passed as a numeric prefix argument.
+Interactively, INCREMENT is the prefix numeric argument, and defaults
+to 1. Positive values of INCREMENT increase the font size, negative
+values decrease it.
-The adjustment made depends on the final component of the key binding
-used to invoke the command, with all modifiers removed:
+When you invoke this command, it performs the initial change of the
+font size, and after that allows further changes by typing one of the
+following keys immediately after invoking the command:
\\`+', \\`=' Globally increase the height of the default face
\\`-' Globally decrease the height of the default face
\\`0' Globally reset the height of the default face
-After adjusting, further adjust the font size as long as the key,
-with all modifiers removed, is one of the above characters.
+(The change of the font size produced by these keys depends on the
+final component of the key sequence, with all modifiers removed.)
Buffer-local face adjustments have higher priority than global
face adjustments.
@@ -488,7 +498,10 @@ The variable `global-text-scale-adjust-resizes-frames'
controls
whether the frames are resized to keep the same number of lines
and characters per line when the font size is adjusted.
-See also the related command `text-scale-adjust'."
+See also the related command `text-scale-adjust'. Unlike that
+command, which scales the font size with a factor,
+`global-text-scale-adjust' scales the font size with an
+increment."
(interactive "p")
(when (display-graphic-p)
(unless global-text-scale-adjust--default-height
@@ -499,16 +512,24 @@ See also the related command `text-scale-adjust'."
(cur (face-attribute 'default :height))
(inc
(pcase key
- (?- (* (- increment) 5))
+ (?- (* (- increment)
+ global-text-scale-adjust--increment-factor))
(?0 (- global-text-scale-adjust--default-height cur))
- (_ (* increment 5))))
+ (_ (* increment
+ global-text-scale-adjust--increment-factor))))
(new (+ cur inc)))
(when (< (car global-text-scale-adjust-limits)
new
(cdr global-text-scale-adjust-limits))
(let ((frame-inhibit-implied-resize
(not global-text-scale-adjust-resizes-frames)))
- (set-face-attribute 'default nil :height new)))
+ (set-face-attribute 'default nil :height new)
+ (redisplay 'force)
+ (when (and (not (and (characterp key) (= key ?0)))
+ (= cur (face-attribute 'default :height)))
+ (setq global-text-scale-adjust--increment-factor
+ (1+ global-text-scale-adjust--increment-factor))
+ (global-text-scale-adjust increment))))
(when (characterp key)
(set-transient-map
(let ((map (make-sparse-keymap)))
diff --git a/lisp/faces.el b/lisp/faces.el
index 09e8110449..c69339e2fd 100644
--- a/lisp/faces.el
+++ b/lisp/faces.el
@@ -787,13 +787,12 @@ specified below. WIDTH specifies the width of the lines
to draw; it
defaults to 1. If WIDTH is negative, the absolute value is the width
of the lines, and draw top/bottom lines inside the characters area,
not around it. COLOR is the name of the color to draw in, default is
-the foreground color of the face for simple boxes, and the background
-color of the face for 3D boxes. STYLE specifies whether a 3D box
-should be draw. If STYLE is `released-button', draw a box looking
-like a released 3D button. If STYLE is `pressed-button' draw a box
-that appears like a pressed button. If STYLE is nil, the default if
-the property list doesn't contain a style specification, draw a 2D
-box.
+the background color of the face for 3D boxes and `flat-button', and
+the foreground color of the face for other boxes. STYLE specifies
+whether a 3D box should be draw. If STYLE is `released-button', draw
+a box looking like a released 3D button. If STYLE is `pressed-button'
+draw a box that appears like a pressed button. If STYLE is nil,
+`flat-button' or omitted, draw a 2D box.
`:inverse-video'
@@ -2201,8 +2200,13 @@ the X resource \"reverseVideo\" is present, handle that."
border-color cursor-color mouse-color
visibility scroll-bar-foreground
scroll-bar-background))
+ (delayed-font nil)
frame success)
(dolist (param delayed-params)
+ ;; Save the font used here. Once the frame is created, set the
+ ;; `font-parameter' frame parameter.
+ (when (and (eq param 'font) (assq 'font parameters))
+ (setq delayed-font (cdr (assq 'font parameters))))
(setq params (assq-delete-all param params)))
(setq frame (x-create-frame `((visibility . nil) . ,params)))
(unwind-protect
@@ -2213,6 +2217,11 @@ the X resource \"reverseVideo\" is present, handle that."
(x-handle-reverse-video frame parameters)
(frame-set-background-mode frame t)
(face-set-after-frame-default frame parameters)
+ ;; The code above will not set the `font-parameter' frame
+ ;; property, which is used by dynamic-setting.el to respect
+ ;; fonts specified by the user via frame parameters (as
+ ;; opposed to face attributes). Set the parameter manually.
+ (set-frame-parameter frame 'font-parameter delayed-font)
;; Mark frame as 'was-invisible' when it was created as
;; invisible or iconified and PARAMETERS contains either a
;; width or height specification. This should be sufficient
diff --git a/lisp/files-x.el b/lisp/files-x.el
index da1e44e250..7199db3e44 100644
--- a/lisp/files-x.el
+++ b/lisp/files-x.el
@@ -489,7 +489,9 @@ from the MODE alist ignoring the input argument VALUE."
dir-locals-directory-cache))
;; Insert modified alist of directory-local variables.
- (insert ";;; Directory Local Variables\n")
+ ;; When changing this, also update the ".dir-locals.el" file for
+ ;; Emacs itself, as well as the template in autoinsert.el.
+ (insert ";;; Directory Local Variables -*- no-byte-compile: t
-*-\n")
(insert ";;; For more information see (info \"(emacs) Directory
Variables\")\n\n")
(princ (dir-locals-to-string
(sort variables
@@ -618,16 +620,25 @@ PROFILES is a list of connection profiles (symbols)."
:group 'tramp
:version "29.1")
+(defvar connection-local-criteria nil
+ "The current connection-local criteria, or nil.
+This is set while executing the body of
+`with-connection-local-variables'.")
+
+(defvar connection-local-profile-name-for-setq nil
+ "The current connection-local profile name, or nil.
+This is the name of the profile to use when setting variables via
+`setq-connection-local'. Its value is derived from
+`connection-local-criteria' and is set while executing the body
+of `with-connection-local-variables'.")
+
(defsubst connection-local-normalize-criteria (criteria)
"Normalize plist CRITERIA according to properties.
Return a reordered plist."
- (apply
- #'append
- (mapcar
- (lambda (property)
- (when (and (plist-member criteria property) (plist-get criteria
property))
- (list property (plist-get criteria property))))
- '(:application :protocol :user :machine))))
+ (mapcan (lambda (property)
+ (let ((value (plist-get criteria property)))
+ (and value (list property value))))
+ '(:application :protocol :user :machine)))
(defsubst connection-local-get-profiles (criteria)
"Return the connection profiles list for CRITERIA.
@@ -694,6 +705,23 @@ in order."
(customize-set-variable
'connection-local-profile-alist connection-local-profile-alist))
+;;;###autoload
+(defun connection-local-update-profile-variables (profile variables)
+ "Update the variable settings for PROFILE in-place.
+VARIABLES is a list that declares connection-local variables for
+the connection profile. An element in VARIABLES is an alist
+whose elements are of the form (VAR . VALUE).
+
+Unlike `connection-local-set-profile-variables' (which see), this
+function preserves the values of any existing variable
+definitions that aren't listed in VARIABLES."
+ (when-let ((existing-variables
+ (nreverse (connection-local-get-profile-variables profile))))
+ (dolist (var variables)
+ (setf (alist-get (car var) existing-variables) (cdr var)))
+ (setq variables (nreverse existing-variables)))
+ (connection-local-set-profile-variables profile variables))
+
(defun hack-connection-local-variables (criteria)
"Read connection-local variables according to CRITERIA.
Store the connection-local variables in buffer local
@@ -736,6 +764,15 @@ If APPLICATION is nil,
`connection-local-default-application' is used."
:user ,(file-remote-p default-directory 'user)
:machine ,(file-remote-p default-directory 'host))))
+(defun connection-local-profile-name-for-criteria (criteria)
+ "Get a connection-local profile name based on CRITERIA."
+ (when criteria
+ (let (print-level print-length)
+ (intern (concat
+ "autogenerated-connection-local-profile/"
+ (prin1-to-string
+ (connection-local-normalize-criteria criteria)))))))
+
;;;###autoload
(defmacro with-connection-local-variables (&rest body)
"Apply connection-local variables according to `default-directory'.
@@ -743,16 +780,28 @@ Execute BODY, and unwind connection-local variables."
(declare (debug t))
`(with-connection-local-variables-1 (lambda () ,@body)))
+;;;###autoload
+(defmacro with-connection-local-application-variables (application &rest body)
+ "Apply connection-local variables for APPLICATION in `default-directory'.
+Execute BODY, and unwind connection-local variables."
+ (declare (debug t) (indent 1))
+ `(let ((connection-local-default-application ,application))
+ (with-connection-local-variables-1 (lambda () ,@body))))
+
;;;###autoload
(defun with-connection-local-variables-1 (body-fun)
"Apply connection-local variables according to `default-directory'.
Call BODY-FUN with no args, and then unwind connection-local variables."
(if (file-remote-p default-directory)
- (let ((enable-connection-local-variables t)
- (old-buffer-local-variables (buffer-local-variables))
- connection-local-variables-alist)
- (hack-connection-local-variables-apply
- (connection-local-criteria-for-default-directory))
+ (let* ((enable-connection-local-variables t)
+ (connection-local-criteria
+ (connection-local-criteria-for-default-directory))
+ (connection-local-profile-name-for-setq
+ (connection-local-profile-name-for-criteria
+ connection-local-criteria))
+ (old-buffer-local-variables (buffer-local-variables))
+ connection-local-variables-alist)
+ (hack-connection-local-variables-apply connection-local-criteria)
(unwind-protect
(funcall body-fun)
;; Cleanup.
@@ -764,6 +813,49 @@ Call BODY-FUN with no args, and then unwind
connection-local variables."
;; No connection-local variables to apply.
(funcall body-fun)))
+;;;###autoload
+(defmacro setq-connection-local (&rest pairs)
+ "Set each VARIABLE connection-locally to VALUE.
+
+When `connection-local-profile-name-for-setq' is set, assign each
+variable's value on that connection profile, and set that profile
+for `connection-local-criteria'. You can use this in combination
+with `with-connection-local-variables', as in
+
+ (with-connection-local-variables
+ (setq-connection-local VARIABLE VALUE))
+
+If there's no connection-local profile to use, just set the
+variables normally, as with `setq'.
+
+The variables are literal symbols and should not be quoted. The
+second VALUE is not computed until after the first VARIABLE is
+set, and so on; each VALUE can use the new value of variables set
+earlier in the `setq-connection-local'. The return value of the
+`setq-connection-local' form is the value of the last VALUE.
+
+\(fn [VARIABLE VALUE]...)"
+ (declare (debug setq))
+ (unless (zerop (mod (length pairs) 2))
+ (error "PAIRS must have an even number of variable/value members"))
+ (let ((set-expr nil)
+ (profile-vars nil))
+ (while pairs
+ (unless (symbolp (car pairs))
+ (error "Attempting to set a non-symbol: %s" (car pairs)))
+ (push `(set ',(car pairs) ,(cadr pairs)) set-expr)
+ (push `(cons ',(car pairs) ,(car pairs)) profile-vars)
+ (setq pairs (cddr pairs)))
+ `(prog1
+ ,(macroexp-progn (nreverse set-expr))
+ (when connection-local-profile-name-for-setq
+ (connection-local-update-profile-variables
+ connection-local-profile-name-for-setq
+ (list ,@(nreverse profile-vars)))
+ (connection-local-set-profiles
+ connection-local-criteria
+ connection-local-profile-name-for-setq)))))
+
;;;###autoload
(defun path-separator ()
"The connection-local value of `path-separator'."
diff --git a/lisp/files.el b/lisp/files.el
index 43c5d7d1da..b947451369 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -208,9 +208,10 @@ if the file has changed on disk and you have not edited
the buffer."
:group 'find-file)
(defvar-local buffer-file-number nil
- "The device number and file number of the file visited in the current buffer.
-The value is a list of the form (FILENUM DEVNUM).
-This pair of numbers uniquely identifies the file.
+ "The inode number and the device of the file visited in the current buffer.
+The value is a list of the form (INODENUM DEVICE), where DEVICE can be
+either a single number or a cons cell of two numbers.
+This tuple of numbers uniquely identifies the file.
If the buffer is visiting a new file, the value is nil.")
(put 'buffer-file-number 'permanent-local t)
@@ -2163,7 +2164,7 @@ If there is no such live buffer, return nil."
(setq list (cdr list)))
found)
(let* ((attributes (file-attributes truename))
- (number (nthcdr 10 attributes))
+ (number (file-attribute-file-identifier attributes))
(list (buffer-list)) found)
(and buffer-file-numbers-unique
(car-safe number) ;Make sure the inode is not just nil.
@@ -2366,7 +2367,7 @@ the various files."
(let* ((buf (get-file-buffer filename))
(truename (abbreviate-file-name (file-truename filename)))
(attributes (file-attributes truename))
- (number (nthcdr 10 attributes))
+ (number (file-attribute-file-identifier attributes))
;; Find any buffer for a file that has same truename.
(other (and (not buf)
(find-buffer-visiting
@@ -3862,7 +3863,7 @@ If these settings come from directory-local variables,
then
DIR-NAME is the name of the associated directory. Otherwise it is nil."
;; Find those variables that we may want to save to
;; `safe-local-variable-values'.
- (let (all-vars risky-vars unsafe-vars ignored)
+ (let (all-vars risky-vars unsafe-vars)
(dolist (elt variables)
(let ((var (car elt))
(val (cdr elt)))
@@ -4744,7 +4745,7 @@ the old visited file has been renamed to the new name
FILENAME."
(setq buffer-file-name truename))))
(setq buffer-file-number
(if filename
- (nthcdr 10 (file-attributes buffer-file-name))
+ (file-attribute-file-identifier (file-attributes
buffer-file-name))
nil))
;; write-file-functions is normally used for things like ftp-find-file
;; that visit things that are not local files as if they were files.
@@ -5733,7 +5734,8 @@ Before and after saving the buffer, this function runs
(setq save-buffer-coding-system last-coding-system-used)
(setq buffer-file-coding-system last-coding-system-used))
(setq buffer-file-number
- (nthcdr 10 (file-attributes buffer-file-name)))
+ (file-attribute-file-identifier
+ (file-attributes buffer-file-name)))
(if setmodes
(condition-case ()
(progn
@@ -6344,9 +6346,10 @@ If FILE1 or FILE2 does not exist, the return value is
unspecified."
(equal f1-attr f2-attr))))))
(defun file-in-directory-p (file dir)
- "Return non-nil if FILE is in DIR or a subdirectory of DIR.
-A directory is considered to be \"in\" itself.
-Return nil if DIR is not an existing directory."
+ "Return non-nil if DIR is a parent directory of FILE.
+Value is non-nil if FILE is inside DIR or inside a subdirectory of DIR.
+A directory is considered to be a \"parent\" of itself.
+DIR must be an existing directory, otherwise the function returns nil."
(let ((handler (or (find-file-name-handler file 'file-in-directory-p)
(find-file-name-handler dir 'file-in-directory-p))))
(if handler
@@ -7291,7 +7294,7 @@ by `sh' are supported."
(setq i (1+ i))
"[]"))
(t "["))
- (prog1 ; copy everything upto next `]'.
+ (prog1 ; copy everything up to next `]'.
(substring wildcard
i
(setq j (string-search
@@ -8657,19 +8660,26 @@ It is a nonnegative integer."
(defsubst file-attribute-device-number (attributes)
"The file system device number in ATTRIBUTES returned by `file-attributes'.
-It is an integer."
+It is an integer or a cons cell of integers."
(nth 11 attributes))
+(defsubst file-attribute-file-identifier (attributes)
+ "The inode and device numbers in ATTRIBUTES returned by `file-attributes'.
+The value is a list of the form (INODENUM DEVICE), where DEVICE could be
+either a single number or a cons cell of two numbers.
+This tuple of numbers uniquely identifies the file."
+ (nthcdr 10 attributes))
+
(defun file-attribute-collect (attributes &rest attr-names)
"Return a sublist of ATTRIBUTES returned by `file-attributes'.
ATTR-NAMES are symbols with the selected attribute names.
Valid attribute names are: type, link-number, user-id, group-id,
access-time, modification-time, status-change-time, size, modes,
-inode-number and device-number."
+inode-number, device-number and file-number."
(let ((all '(type link-number user-id group-id access-time
modification-time status-change-time
- size modes inode-number device-number))
+ size modes inode-number device-number file-number))
result)
(while attr-names
(let ((attr (pop attr-names)))
diff --git a/lisp/filesets.el b/lisp/filesets.el
index aeebd907c3..9f07072e78 100644
--- a/lisp/filesets.el
+++ b/lisp/filesets.el
@@ -2390,6 +2390,7 @@ fileset thinks this is necessary or not."
(filesets-menu-cache-file-load))
(defun filesets-update-pre010505 ()
+ (declare (obsolete nil "29.1"))
(let ((msg (format-message
"Filesets: manual editing of user data required!
@@ -2435,7 +2436,8 @@ We apologize for the inconvenience.")))
((or (not cached-version)
(string< cached-version "1.5.5")
(boundp 'filesets-subdocument-patterns))
- (filesets-update-pre010505)))
+ (with-suppressed-warnings ((obsolete filesets-update-pre010505))
+ (filesets-update-pre010505))))
(filesets-update-cleanup))
(defun filesets-menu-cache-file-load ()
diff --git a/lisp/follow.el b/lisp/follow.el
index adf1c1b762..c26949985e 100644
--- a/lisp/follow.el
+++ b/lisp/follow.el
@@ -1301,7 +1301,7 @@ non-first windows in Follow mode."
"The buffer current at the last call to `follow-adjust-window' or nil.
`follow-mode' is not necessarily enabled in this buffer.")
-;; This function is added to `pre-display-function' and is thus called
+;; This function is added to `pre-redisplay-function' and is thus called
;; before each redisplay operation. It supersedes (2018-09) the
;; former use of the post command hook, and now does the right thing
;; when a program calls `redisplay' or `sit-for'.
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
index bb89557863..bf9a179d6a 100644
--- a/lisp/font-lock.el
+++ b/lisp/font-lock.el
@@ -641,16 +641,6 @@ Major/minor modes can set this variable if they know which
option applies.")
;; Font Lock mode.
-(eval-when-compile
- ;;
- ;; We use this to preserve or protect things when modifying text properties.
- (defmacro save-buffer-state (&rest body)
- "Bind variables according to VARLIST and eval BODY restoring buffer state."
- (declare (indent 0) (debug t))
- `(let ((inhibit-point-motion-hooks t))
- (with-silent-modifications
- ,@body))))
-
(defvar-local font-lock-set-defaults nil) ; Whether we have set up defaults.
(defun font-lock-specified-p (mode)
@@ -1014,7 +1004,7 @@ This works by calling
`font-lock-fontify-region-function'."
(defun font-lock-unfontify-region (beg end)
"Unfontify the text between BEG and END.
This works by calling `font-lock-unfontify-region-function'."
- (save-buffer-state
+ (with-silent-modifications
(funcall font-lock-unfontify-region-function beg end)))
(defvar font-lock-flush-function #'font-lock-after-change-function
@@ -1164,7 +1154,7 @@ Put first the functions more likely to cause a change and
cheaper to compute.")
"Fontify the text between BEG and END.
If LOUDLY is non-nil, print status messages while fontifying.
This function is the default `font-lock-fontify-region-function'."
- (save-buffer-state
+ (with-silent-modifications
;; Use the fontification syntax table, if any.
(with-syntax-table (or font-lock-syntax-table (syntax-table))
;; Extend the region to fontify so that it starts and ends at
@@ -1223,8 +1213,7 @@ This function is the default
`font-lock-unfontify-region-function'."
;; Called when any modification is made to buffer text.
(defun font-lock-after-change-function (beg end &optional old-len)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-quit t)
+ (let ((inhibit-quit t)
(region (if font-lock-extend-after-change-region-function
(funcall font-lock-extend-after-change-region-function
beg end old-len))))
@@ -1319,8 +1308,7 @@ no ARG is given and `font-lock-mark-block-function' is
nil.
If `font-lock-mark-block-function' non-nil and no ARG is given, it is used to
delimit the region to fontify."
(interactive "P")
- (let ((inhibit-point-motion-hooks t)
- deactivate-mark)
+ (let (deactivate-mark)
;; Make sure we have the right `font-lock-keywords' etc.
(if (not font-lock-mode) (font-lock-set-defaults))
(save-mark-and-excursion
diff --git a/lisp/format.el b/lisp/format.el
index 2c368b8f9c..5cd2d4bfb4 100644
--- a/lisp/format.el
+++ b/lisp/format.el
@@ -440,10 +440,9 @@ a list (ABSOLUTE-FILE-NAME SIZE)."
(file-name-nondirectory file)))))
(list file fmt)))
(let (value size old-undo)
- ;; Record only one undo entry for the insertion. Inhibit point-motion and
- ;; modification hooks as with `insert-file-contents'.
- (let ((inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t))
+ ;; Record only one undo entry for the insertion.
+ ;; Inhibit modification hooks as with `insert-file-contents'.
+ (let ((inhibit-modification-hooks t))
;; Don't bind `buffer-undo-list' to t here to assert that
;; `insert-file-contents' may record whether the buffer was unmodified
;; before.
diff --git a/lisp/forms.el b/lisp/forms.el
index fdc44b5214..97c7cb79d3 100644
--- a/lisp/forms.el
+++ b/lisp/forms.el
@@ -487,17 +487,11 @@ Commands: Equivalent keys in
read-only mode:
(make-local-variable 'forms-insert-after)
(make-local-variable 'forms-use-text-properties)
- ;; Filter functions.
- (make-local-variable 'forms-read-file-filter)
- (make-local-variable 'forms-write-file-filter)
- (make-local-variable 'forms-new-record-filter)
- (make-local-variable 'forms-modified-record-filter)
-
- ;; Make sure no filters exist.
- (setq forms-read-file-filter nil)
- (setq forms-write-file-filter nil)
- (setq forms-new-record-filter nil)
- (setq forms-modified-record-filter nil)
+ ;; Make sure no filters exist.
+ (setq-local forms-read-file-filter nil)
+ (setq-local forms-write-file-filter nil)
+ (setq-local forms-new-record-filter nil)
+ (setq-local forms-modified-record-filter nil)
;; Setup faces to show read-only and read-write fields.
(make-local-variable 'forms-ro-face)
@@ -615,10 +609,10 @@ Commands: Equivalent keys in
read-only mode:
(make-local-variable 'forms--the-record-list)
(make-local-variable 'forms--search-regexp)
- ; The keymaps are global, so multiple forms mode buffers can share them.
- ;(make-local-variable 'forms-mode-map)
- ;(make-local-variable 'forms-mode-ro-map)
- ;(make-local-variable 'forms-mode-edit-map)
+ ;; The keymaps are global, so multiple forms mode buffers can share them.
+ ;;(make-local-variable 'forms-mode-map)
+ ;;(make-local-variable 'forms-mode-ro-map)
+ ;;(make-local-variable 'forms-mode-edit-map)
(if forms-mode-map ; already defined
nil
;;(message "forms: building keymap...")
@@ -715,8 +709,8 @@ Commands: Equivalent keys in
read-only mode:
;;(message "forms: setting up... done.")
;; be helpful
- (forms--help)
-)
+ (forms--help))
+
(defun forms--process-format-list ()
;; Validate `forms-format-list' and set some global variables.
@@ -1928,8 +1922,7 @@ after writing out the data."
(let ((i 0)
(here (point))
there
- (cnt 0)
- (inhibit-point-motion-hooks t))
+ (cnt 0))
(if (zerop arg)
(setq cnt 1)
@@ -1955,8 +1948,7 @@ after writing out the data."
(let ((i (length forms--markers))
(here (point))
there
- (cnt 0)
- (inhibit-point-motion-hooks t))
+ (cnt 0))
(if (zerop arg)
(setq cnt 1)
diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1
index 1949f62609..002b7bcfff 100644
--- a/lisp/gnus/ChangeLog.1
+++ b/lisp/gnus/ChangeLog.1
@@ -910,7 +910,7 @@
1998-07-11 Mike McEwan <mike@lotusland.demon.co.uk>
* gnus-agent.el (gnus-agent-fetch-headers): Note last fetched
- headers per sesion to aid expiry in `headers only' groups.
+ headers per session to aid expiry in `headers only' groups.
* gnus-agent.el (gnus-agent-expire): Update group info to add
expired articles to list of read articles and prevent
diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3
index c33c76f68d..c55d6225e3 100644
--- a/lisp/gnus/ChangeLog.3
+++ b/lisp/gnus/ChangeLog.3
@@ -4243,7 +4243,7 @@
* gnus-msg.el (gnus-inews-do-gcc):
* message.el (message-send-mail):
* mml.el (mml-generate-mime): Share the value of the buffer-local
- `message-options' variable between a draft buffer and temprary working
+ `message-options' variable between a draft buffer and temporary working
buffers.
2011-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -4902,7 +4902,7 @@
2011-07-31 Marcus Harnisch <marcus.harnisch@gmx.net> (tiny change)
* gnus-art.el (gnus-article-stop-animations): Use `elt' instead of
- `aref' for XEmacs compatibiltiy.
+ `aref' for XEmacs compatibility.
2011-07-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -10876,7 +10876,7 @@
2010-09-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-group.el (gnus-group-line-format-alist): Have the ?U (unseen)
- spec inser "*" if the group isn't active instead of 0.
+ spec insert "*" if the group isn't active instead of 0.
* nnimap.el (nnimap-request-group): Don't select the imap buffer before
opening the server.
@@ -23276,7 +23276,7 @@
Signal a specific `search-failed' rather than a generic `error'.
* gnus-salt.el (gnus-pick-mouse-pick-region): Switch 1 => point-min.
- (gnus-generate-vertical-tree): Usue `bobp' rather than compare to 1.
+ (gnus-generate-vertical-tree): Use `bobp' rather than compare to 1.
(gnus-highlight-selected-tree): Use point-min rather than 1 and 2.
2004-09-10 Simon Josefsson <jas@extundo.com>
diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el
index fbcf801313..814d21823d 100644
--- a/lisp/gnus/gnus-art.el
+++ b/lisp/gnus/gnus-art.el
@@ -26,7 +26,6 @@
(eval-when-compile (require 'cl-lib))
(defvar tool-bar-map)
-(defvar w3m-minor-mode-map)
(require 'gnus)
(require 'gnus-sum)
@@ -1765,7 +1764,6 @@ Initialized from `text-mode-syntax-table'.")
`(with-current-buffer gnus-article-buffer
(save-restriction
(let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t)
(case-fold-search t))
(article-narrow-to-head)
,@forms))))
@@ -1852,7 +1850,6 @@ Initialized from `text-mode-syntax-table'.")
(let ((inhibit-read-only t)
(case-fold-search t)
(max (1+ (length gnus-sorted-header-list)))
- (inhibit-point-motion-hooks t)
(cur (current-buffer))
ignored visible beg)
(save-excursion
@@ -1919,8 +1916,7 @@ always hide."
(not gnus-show-all-headers))
(save-excursion
(save-restriction
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t))
+ (let ((inhibit-read-only t))
(article-narrow-to-head)
(dolist (elem gnus-boring-article-headers)
(goto-char (point-min))
@@ -2567,8 +2563,7 @@ fill width."
"Decode all MIME-encoded words in the article."
(interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
- (let ((inhibit-point-motion-hooks t)
- (mail-parse-charset gnus-newsgroup-charset)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(with-current-buffer gnus-summary-buffer
gnus-newsgroup-ignored-charsets)))
@@ -2578,7 +2573,7 @@ fill width."
"Decode charset-encoded text in the article.
If PROMPT (the prefix), prompt for a coding system to use."
(interactive "P" gnus-article-mode)
- (let ((inhibit-point-motion-hooks t) (case-fold-search t)
+ (let ((case-fold-search t)
(inhibit-read-only t)
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
@@ -2620,8 +2615,7 @@ If PROMPT (the prefix), prompt for a coding system to
use."
(defun article-decode-encoded-words ()
"Remove encoded-word encoding from headers."
- (let ((inhibit-point-motion-hooks t)
- (mail-parse-charset gnus-newsgroup-charset)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(save-excursion (condition-case nil
(set-buffer gnus-summary-buffer)
@@ -2668,8 +2662,7 @@ If PROMPT (the prefix), prompt for a coding system to
use."
(defun article-decode-group-name ()
"Decode group names in Newsgroups, Followup-To and Xref headers."
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t)
+ (let ((inhibit-read-only t)
(method (gnus-find-method-for-group gnus-newsgroup-name))
regexp)
(when (and (or gnus-group-name-charset-method-alist
@@ -2699,8 +2692,7 @@ The following headers are decoded: From:, To:, Cc:,
Reply-To:,
Mail-Reply-To: and Mail-Followup-To:."
(when gnus-use-idna
(save-restriction
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
(article-narrow-to-head)
(goto-char (point-min))
(while (re-search-forward "@[^ \t\n\r,>]*\\(xn--[-A-Za-z0-9.]*\\)[
\t\n\r,>]" nil t)
@@ -3171,8 +3163,7 @@ images if any to the browser, and deletes them when
exiting the group
"Remove list identifiers from the Subject header.
The `gnus-list-identifiers' variable specifies what to do."
(interactive nil gnus-article-mode)
- (let ((inhibit-point-motion-hooks t)
- (regexp (gnus-group-get-list-identifiers gnus-newsgroup-name))
+ (let ((regexp (gnus-group-get-list-identifiers gnus-newsgroup-name))
(inhibit-read-only t))
(when regexp
(save-excursion
@@ -3221,34 +3212,32 @@ always hide."
(interactive nil gnus-article-mode)
(save-excursion
(save-restriction
- (let ((inhibit-point-motion-hooks t))
- (when (gnus-parameter-banner gnus-newsgroup-name)
- (article-really-strip-banner
- (gnus-parameter-banner gnus-newsgroup-name)))
- (when gnus-article-address-banner-alist
- ;; Note that the From header is decoded here, so it is
- ;; required that the *-extract-address-components function
- ;; supports non-ASCII text.
- (let ((from (save-restriction
- (widen)
- (article-narrow-to-head)
- (mail-fetch-field "from"))))
- (when (and from
- (setq from
- (cadr (funcall gnus-extract-address-components
- from))))
- (catch 'found
- (dolist (pair gnus-article-address-banner-alist)
- (when (string-match (car pair) from)
- (throw 'found
- (article-really-strip-banner (cdr pair)))))))))))))
+ (when (gnus-parameter-banner gnus-newsgroup-name)
+ (article-really-strip-banner
+ (gnus-parameter-banner gnus-newsgroup-name)))
+ (when gnus-article-address-banner-alist
+ ;; Note that the From header is decoded here, so it is
+ ;; required that the *-extract-address-components function
+ ;; supports non-ASCII text.
+ (let ((from (save-restriction
+ (widen)
+ (article-narrow-to-head)
+ (mail-fetch-field "from"))))
+ (when (and from
+ (setq from
+ (cadr (funcall gnus-extract-address-components
+ from))))
+ (catch 'found
+ (dolist (pair gnus-article-address-banner-alist)
+ (when (string-match (car pair) from)
+ (throw 'found
+ (article-really-strip-banner (cdr pair))))))))))))
(defun article-really-strip-banner (banner)
"Strip the banner specified by the argument."
(save-excursion
(save-restriction
- (let ((inhibit-point-motion-hooks t)
- (gnus-signature-limit nil)
+ (let ((gnus-signature-limit nil)
(inhibit-read-only t))
(article-goto-body)
(cond
@@ -3307,8 +3296,7 @@ always hide."
"Remove all blank lines from the beginning of the article."
(interactive nil gnus-article-mode)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
(when (article-goto-body)
(while (and (not (eobp))
(looking-at "[ \t]*$"))
@@ -3349,8 +3337,7 @@ Point is left at the beginning of the narrowed-to region."
"Replace consecutive blank lines with one empty line."
(interactive nil gnus-article-mode)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
;; First make all blank lines empty.
(article-goto-body)
(while (re-search-forward "^[ \t]+$" nil t)
@@ -3368,8 +3355,7 @@ Point is left at the beginning of the narrowed-to region."
"Remove all white space from the beginning of the lines in the article."
(interactive nil gnus-article-mode)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
(article-goto-body)
(while (re-search-forward "^[ \t]+" nil t)
(replace-match "" t t)))))
@@ -3378,8 +3364,7 @@ Point is left at the beginning of the narrowed-to region."
"Remove all white space from the end of the lines in the article."
(interactive nil gnus-article-mode)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
(article-goto-body)
(while (re-search-forward "[ \t]+$" nil t)
(replace-match "" t t)))))
@@ -3395,37 +3380,35 @@ Point is left at the beginning of the narrowed-to
region."
"Strip all blank lines."
(interactive nil gnus-article-mode)
(save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
+ (let ((inhibit-read-only t))
(article-goto-body)
(while (re-search-forward "^[ \t]*\n" nil t)
(replace-match "" t t)))))
(defun gnus-article-narrow-to-signature ()
"Narrow to the signature; return t if a signature is found, else nil."
- (let ((inhibit-point-motion-hooks t))
- (when (gnus-article-search-signature)
- (forward-line 1)
- ;; Check whether we have some limits to what we consider
- ;; to be a signature.
- (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
- (list gnus-signature-limit)))
- limit limited)
- (while (setq limit (pop limits))
- (if (or (and (integerp limit)
- (< (- (point-max) (point)) limit))
- (and (floatp limit)
- (< (count-lines (point) (point-max)) limit))
- (and (functionp limit)
- (funcall limit))
- (and (stringp limit)
- (not (re-search-forward limit nil t))))
- () ; This limit did not succeed.
- (setq limited t
- limits nil)))
- (unless limited
- (narrow-to-region (point) (point-max))
- t)))))
+ (when (gnus-article-search-signature)
+ (forward-line 1)
+ ;; Check whether we have some limits to what we consider
+ ;; to be a signature.
+ (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
+ (list gnus-signature-limit)))
+ limit limited)
+ (while (setq limit (pop limits))
+ (if (or (and (integerp limit)
+ (< (- (point-max) (point)) limit))
+ (and (floatp limit)
+ (< (count-lines (point) (point-max)) limit))
+ (and (functionp limit)
+ (funcall limit))
+ (and (stringp limit)
+ (not (re-search-forward limit nil t))))
+ () ; This limit did not succeed.
+ (setq limited t
+ limits nil)))
+ (unless limited
+ (narrow-to-region (point) (point-max))
+ t))))
(defun gnus-article-search-signature ()
"Search the current buffer for the signature separator.
@@ -3485,8 +3468,7 @@ means show, 0 means toggle."
(defun gnus-article-show-hidden-text (type &optional _dummy)
"Show all hidden text of type TYPE.
Originally it is hide instead of DUMMY."
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t))
+ (let ((inhibit-read-only t))
(gnus-remove-text-properties-when
'article-type type
(point-min) (point-max)
@@ -3528,7 +3510,6 @@ possible values."
(interactive (list 'ut t) gnus-article-mode)
(let* ((case-fold-search t)
(inhibit-read-only t)
- (inhibit-point-motion-hooks t)
(visible-date (mail-fetch-field "Date"))
pos date bface eface)
(save-excursion
@@ -4351,8 +4332,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is
(insert-buffer-substring gnus-original-article-buffer)
(setq items (split-string sig))
(message-narrow-to-head)
- (let ((inhibit-point-motion-hooks t)
- (case-fold-search t))
+ (let ((case-fold-search t))
;; Don't verify multiple headers.
(setq headers (mapconcat (lambda (header)
(concat header ": "
@@ -6811,16 +6791,15 @@ not have a face in `gnus-article-boring-faces'."
(boundp 'gnus-article-boring-faces)
(symbol-value 'gnus-article-boring-faces))
(save-excursion
- (let ((inhibit-point-motion-hooks t))
- (catch 'only-boring
- (while (re-search-forward "\\b\\w\\w" nil t)
- (forward-char -1)
- (when (not (seq-intersection
- (gnus-faces-at (point))
- (symbol-value 'gnus-article-boring-faces)
- #'eq))
- (throw 'only-boring nil)))
- (throw 'only-boring t))))))
+ (catch 'only-boring
+ (while (re-search-forward "\\b\\w\\w" nil t)
+ (forward-char -1)
+ (when (not (seq-intersection
+ (gnus-faces-at (point))
+ (symbol-value 'gnus-article-boring-faces)
+ #'eq))
+ (throw 'only-boring nil)))
+ (throw 'only-boring t)))))
(defun gnus-article-refer-article ()
"Read article specified by message-id around point."
@@ -8112,18 +8091,17 @@ It does this by highlighting everything after
`gnus-signature-separator' using the face `gnus-signature'."
(interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
- (let ((inhibit-point-motion-hooks t))
- (save-restriction
- (when (and gnus-signature-face
- (gnus-article-narrow-to-signature))
- (overlay-put (make-overlay (point-min) (point-max) nil t)
- 'face gnus-signature-face)
- (widen)
- (gnus-article-search-signature)
- (let ((start (match-beginning 0))
- (end (set-marker (make-marker) (1+ (match-end 0)))))
- (gnus-article-add-button start (1- end) 'gnus-signature-toggle
- end)))))))
+ (save-restriction
+ (when (and gnus-signature-face
+ (gnus-article-narrow-to-signature))
+ (overlay-put (make-overlay (point-min) (point-max) nil t)
+ 'face gnus-signature-face)
+ (widen)
+ (gnus-article-search-signature)
+ (let ((start (match-beginning 0))
+ (end (set-marker (make-marker) (1+ (match-end 0)))))
+ (gnus-article-add-button start (1- end) 'gnus-signature-toggle
+ end))))))
(defun gnus-button-in-region-p (b e prop)
"Say whether PROP exists in the region."
@@ -8135,8 +8113,7 @@ It does this by highlighting everything after
specified by `gnus-button-alist'."
(interactive nil gnus-article-mode gnus-summary-mode)
(gnus-with-article-buffer
- (let ((inhibit-point-motion-hooks t)
- (case-fold-search t)
+ (let ((case-fold-search t)
(alist gnus-button-alist)
beg entry regexp)
;; We skip the headers.
@@ -8292,19 +8269,18 @@ url is put as the `gnus-button-url' overlay property on
the button."
(defun gnus-signature-toggle (end)
(gnus-with-article-buffer
- (let ((inhibit-point-motion-hooks t))
- (if (text-property-any end (point-max) 'article-type 'signature)
- (progn
- (gnus-delete-wash-type 'signature)
- (gnus-remove-text-properties-when
- 'article-type 'signature end (point-max)
- (cons 'article-type (cons 'signature
- gnus-hidden-properties))))
- (gnus-add-wash-type 'signature)
- (gnus-add-text-properties-when
- 'article-type nil end (point-max)
- (cons 'article-type (cons 'signature
- gnus-hidden-properties)))))
+ (if (text-property-any end (point-max) 'article-type 'signature)
+ (progn
+ (gnus-delete-wash-type 'signature)
+ (gnus-remove-text-properties-when
+ 'article-type 'signature end (point-max)
+ (cons 'article-type (cons 'signature
+ gnus-hidden-properties))))
+ (gnus-add-wash-type 'signature)
+ (gnus-add-text-properties-when
+ 'article-type nil end (point-max)
+ (cons 'article-type (cons 'signature
+ gnus-hidden-properties))))
(let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
(gnus-set-mode-line 'article))))
@@ -8313,8 +8289,7 @@ url is put as the `gnus-button-url' overlay property on
the button."
(save-excursion
(let* ((marker (car marker-and-entry))
(entry (cadr marker-and-entry))
- (regexp (car entry))
- (inhibit-point-motion-hooks t))
+ (regexp (car entry)))
(goto-char marker)
;; This is obviously true, or something bad is happening :)
;; But we need it to have the match-data
diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el
index 18732218c9..29d963984b 100644
--- a/lisp/gnus/gnus-bookmark.el
+++ b/lisp/gnus/gnus-bookmark.el
@@ -65,7 +65,7 @@
;; http://thread.gmane.org/v9fxx9fkm4.fsf@marauder.physik.uni-ulm.de
;; FIXME: Check if `gnus-bookmark.el' should use
-;; `bookmark-make-cell-function'.
+;; `bookmark-make-record-function'.
;; Cf. http://article.gmane.org/gmane.emacs.gnus.general/66076
(defgroup gnus-bookmark nil
diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el
index b4d7661d74..e344b071bf 100644
--- a/lisp/gnus/gnus-cite.el
+++ b/lisp/gnus/gnus-cite.el
@@ -341,7 +341,6 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps
(let ((buffer-read-only nil)
(alist gnus-cite-prefix-alist)
(faces gnus-cite-face-list)
- (inhibit-point-motion-hooks t)
face entry prefix skip numbers number face-alist)
;; Loop through citation prefixes.
(while alist
@@ -462,7 +461,6 @@ text (i.e., computer code and the like) will not be folded."
(interactive "P" gnus-article-mode gnus-summary-mode)
(with-current-buffer gnus-article-buffer
(let ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
(marks (gnus-dissect-cited-text))
(adaptive-fill-mode nil)
(fill-column (if width (prefix-numeric-value width) fill-column)))
@@ -536,7 +534,6 @@ always hide."
(with-current-buffer gnus-article-buffer
(let ((buffer-read-only nil)
marks
- (inhibit-point-motion-hooks t)
(props (nconc (list 'article-type 'cite)
gnus-hidden-properties))
(point (point-min))
@@ -613,7 +610,6 @@ means show, nil means toggle."
(start (cadr args))
(hidden
(text-property-any beg (1- end) 'article-type 'cite))
- (inhibit-point-motion-hooks t)
buffer-read-only)
(when (or (null arg)
(zerop arg)
@@ -673,7 +669,6 @@ See also the documentation for
`gnus-article-highlight-citation'."
(let ((start (point))
(atts gnus-cite-attribution-alist)
(buffer-read-only nil)
- (inhibit-point-motion-hooks t)
(hidden 0)
total)
(goto-char (point-max))
@@ -731,13 +726,12 @@ See also the documentation for
`gnus-article-highlight-citation'."
(defun gnus-cite-parse-wrapper ()
;; Wrap chopped gnus-cite-parse.
(article-goto-body)
- (let ((inhibit-point-motion-hooks t))
- (save-excursion
- (gnus-cite-parse-attributions))
- (save-excursion
- (gnus-cite-parse))
- (save-excursion
- (gnus-cite-connect-attributions))))
+ (save-excursion
+ (gnus-cite-parse-attributions))
+ (save-excursion
+ (gnus-cite-parse))
+ (save-excursion
+ (gnus-cite-connect-attributions)))
(defun gnus-cite-parse ()
;; Parse and connect citation prefixes and attribution lines.
@@ -1020,8 +1014,7 @@ See also the documentation for
`gnus-article-highlight-citation'."
(defun gnus-cite-add-face (number prefix face)
;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
(when face
- (let ((inhibit-point-motion-hooks t)
- from to overlay)
+ (let (from to overlay)
(goto-char (point-min))
(when (zerop (forward-line (1- number)))
(forward-char (length prefix))
@@ -1041,7 +1034,6 @@ See also the documentation for
`gnus-article-highlight-citation'."
(gnus-cite-parse-maybe nil t)
(let ((buffer-read-only nil)
(numbers (cdr (assoc prefix gnus-cite-prefix-alist)))
- (inhibit-point-motion-hooks t)
number)
(while numbers
(setq number (car numbers)
diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el
index 32c475239e..5a0cf77a32 100644
--- a/lisp/gnus/gnus-cus.el
+++ b/lisp/gnus/gnus-cus.el
@@ -41,10 +41,7 @@ The following commands are available:\\<widget-keymap>
\\[widget-forward] Move to next button or editable field.
\\[widget-backward] Move to previous button or editable field.
\\[widget-button-click] Activate button under the mouse pointer.
-\\[widget-button-press] Activate button under point.
-
-Entry to this mode calls the value of `gnus-custom-mode-hook'
-if that value is non-nil."
+\\[widget-button-press] Activate button under point."
(use-local-map widget-keymap)
;; Emacs stuff:
(when (and (facep 'custom-button-face)
diff --git a/lisp/gnus/gnus-gravatar.el b/lisp/gnus/gnus-gravatar.el
index d64e000d70..93b18f9555 100644
--- a/lisp/gnus/gnus-gravatar.el
+++ b/lisp/gnus/gnus-gravatar.el
@@ -87,7 +87,6 @@ callback for `gravatar-retrieve'."
(let ((real-name (car address))
(mail-address (cadr address))
(mark (point-marker))
- (inhibit-point-motion-hooks t)
(case-fold-search t))
(save-restriction
(article-narrow-to-head)
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 35103e9c4f..c7ec65da79 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -393,17 +393,15 @@ variables in the Lisp expression:
"Add Icons to your group buffer."
:group 'gnus-group-visual)
-(defcustom gnus-group-icon-list
- nil
+(defcustom gnus-group-icon-list nil
"Controls the insertion of icons into group buffer lines.
Below is a list of `Form'/`File' pairs. When deciding how a
particular group line should be displayed, each form is evaluated.
The icon from the file field after the first true form is used. You
can change how those group lines are displayed by editing the file
-field. The File will either be found in the
-`gnus-group-glyph-directory' or by designating absolute name of the
-file.
+field. The File will either be found in the `image-load-path'
+or by specifying the absolute name of the file.
It is also possible to change and add form fields, but currently that
requires an understanding of Lisp expressions. Hopefully this will
@@ -2651,6 +2649,7 @@ If EXCLUDE-GROUP, do not go to that group."
(and best-point (gnus-group-group-name))))
;; Is there something like an after-point-motion-hook?
+;; FIXME: There's `cursor-sensor-mode's `cursor-sensor-functions' property.
;; (inhibit-point-motion-hooks?). Is there a tool-bar-update function?
;; (defun gnus-group-menu-bar-update ()
diff --git a/lisp/gnus/gnus-rfc1843.el b/lisp/gnus/gnus-rfc1843.el
index 9872f7b994..da1afb672a 100644
--- a/lisp/gnus/gnus-rfc1843.el
+++ b/lisp/gnus/gnus-rfc1843.el
@@ -40,8 +40,7 @@
(save-excursion
(save-restriction
(message-narrow-to-head)
- (let* ((inhibit-point-motion-hooks t)
- (case-fold-search t)
+ (let* ((case-fold-search t)
(ct (message-fetch-field "Content-Type" t))
(ctl (and ct (mail-header-parse-content-type ct))))
(if (and ctl (not (string-search "/" (car ctl))))
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index b8f7e7a08f..7941496be6 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -1943,7 +1943,7 @@ Assume \"size\" key is equal to \"larger\"."
(thread (alist-get 'thread query)))
(with-slots (switches config-directory) engine
`("find" ; command must come first
- "--nocolor" ; mu will always give coloured output otherwise
+ "--nocolor" ; mu will always give colored output otherwise
,(format "--muhome=%s" config-directory)
,@switches
,(if thread "-r" "")
diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el
index 8d9e50059f..a4962f9d5f 100644
--- a/lisp/gnus/gnus-start.el
+++ b/lisp/gnus/gnus-start.el
@@ -173,7 +173,7 @@ properly with all servers."
Groups with levels less than `gnus-level-subscribed', which
should be less than this variable, are subscribed. Groups with
-levels from `gnus-level-subscribed' (exclusive) upto this
+levels from `gnus-level-subscribed' (exclusive) up to this
variable (inclusive) are unsubscribed. See also
`gnus-level-zombie', `gnus-level-killed' and the Info node `(gnus)Group
Levels' for details.")
@@ -1810,7 +1810,7 @@ where unread is an integer count of calculated unread
messages (or nil), and info is a regular gnus info entry.
The info element is shared with the same element of
-`gnus-newrc-alist', so as to conserve space."
+`gnus-newsrc-alist', so as to conserve space."
(let ((alist gnus-newsrc-alist)
(ohashtb gnus-newsrc-hashtb)
info method gname rest methods)
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 107ad8fd4a..18ba55a439 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -9856,7 +9856,6 @@ If ARG is a negative number, hide the unwanted header
lines."
(widen)
(article-narrow-to-head)
(let* ((inhibit-read-only t)
- (inhibit-point-motion-hooks t)
(hidden (if (numberp arg)
(>= arg 0)
(or
diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el
index fe556b155a..95c9539593 100644
--- a/lisp/gnus/gnus-util.el
+++ b/lisp/gnus/gnus-util.el
@@ -166,9 +166,8 @@ is slower."
(require 'message)
(save-excursion
(save-restriction
- (let ((inhibit-point-motion-hooks t))
- (nnheader-narrow-to-headers)
- (message-fetch-field field)))))
+ (nnheader-narrow-to-headers)
+ (message-fetch-field field))))
(defun gnus-fetch-original-field (field)
"Fetch FIELD from the original version of the current article."
diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el
index beccef6f5f..3bbd68bdcd 100644
--- a/lisp/gnus/message.el
+++ b/lisp/gnus/message.el
@@ -2172,8 +2172,7 @@ If FIRST is non-nil, only the first value is returned.
The buffer is expected to be narrowed to just the header of the message;
see `message-narrow-to-headers-or-head'."
- (let* ((inhibit-point-motion-hooks t)
- (value (mail-fetch-field header nil (not first))))
+ (let* ((value (mail-fetch-field header nil (not first))))
(when value
(while (string-match "\n[\t ]+" value)
(setq value (replace-match " " t t value)))
@@ -4362,10 +4361,10 @@ arguments. If METHOD is nil in this case, the return
value of
the function will be inserted instead.
If the buffer already has a\"X-Message-SMTP-Method\" header,
it is left unchanged."
- :type '(alist :key-type '(choice
- (string :tag "From Address")
- (function :tag "Predicate"))
- :value-type 'string)
+ :type '(alist :key-type (choice
+ (string :tag "From Address")
+ (function :tag "Predicate"))
+ :value-type string)
:version "29.1"
:group 'message-sending)
@@ -4386,7 +4385,7 @@ it is left unchanged."
(setq method (or (cdr server) res))
(throw 'exit nil))))
((and (stringp (car server))
- (string= (car server) from))
+ (string-equal-ignore-case (car server) from))
(setq method (cdr server))
(throw 'exit nil)))))
(when method
@@ -5193,10 +5192,7 @@ command evaluates `message-send-mail-hook' just before
sending a message."
(defun message-canlock-generate ()
"Return a string that is non-trivial to guess.
Do not use this for anything important, it is cryptographically weak."
- (sha1 (concat (message-unique-id)
- (format "%x%x%x" (random) (random) (random))
- (prin1-to-string (recent-keys))
- (prin1-to-string (garbage-collect)))))
+ (secure-hash 'sha1 'iv-auto 128))
(defvar canlock-password)
(defvar canlock-password-for-verify)
@@ -7038,6 +7034,7 @@ is a function used to switch to and display the mail
buffer."
;; Firefox sends us In-Reply-To headers that are Message-IDs
;; without <> around them. Fix that.
(when (and (eq (car h) 'In-Reply-To)
+ (stringp (cdr h))
;; Looks like a Message-ID.
(string-match-p "\\`[^ @]+@[^ @]+\\'" (cdr h))
(not (string-match-p "\\`<.*>\\'" (cdr h))))
@@ -7309,7 +7306,6 @@ specified by FUNCTIONS, if non-nil, or by the variable
(let ((cur (current-buffer))
from subject date
references message-id follow-to
- (inhibit-point-motion-hooks t)
(message-this-is-mail t)
gnus-warning)
(save-restriction
@@ -7370,7 +7366,6 @@ If TO-NEWSGROUPS, use that as the new Newsgroups line."
(let ((cur (current-buffer))
from subject date reply-to mrt mct
references message-id follow-to
- (inhibit-point-motion-hooks t)
(message-this-is-news t)
followup-to distribution newsgroups gnus-warning posted-to)
(save-restriction
@@ -8609,7 +8604,6 @@ From headers in the original article."
(let ((regexps (if (stringp message-hidden-headers)
(list message-hidden-headers)
message-hidden-headers))
- (inhibit-point-motion-hooks t)
(inhibit-modification-hooks t)
end-of-headers)
(when regexps
diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el
index 9045966df5..44ce1c9485 100644
--- a/lisp/gnus/mm-bodies.el
+++ b/lisp/gnus/mm-bodies.el
@@ -189,24 +189,8 @@ If TYPE is `text/plain' CRLF->LF translation may occur."
(quoted-printable-decode-region (point-min) (point-max))
t)
((eq encoding 'base64)
- (base64-decode-region
- (point-min)
- (save-excursion
- ;; Some mailers insert whitespace junk at the end which
- ;; base64-decode-region dislikes.
- (goto-char (point-min))
- (while (re-search-forward "^[\t ]*\r?\n" nil t)
- (delete-region (match-beginning 0) (match-end 0)))
- ;; Also ignore junk which could have been added by
- ;; mailing list software by finding the final line with
- ;; base64 text.
- (goto-char (point-max))
- (beginning-of-line)
- (while (and (not (mm-base64-line-p))
- (not (bobp)))
- (forward-line -1))
- (forward-line 1)
- (point))))
+ ;; MIME says to ignore any non-base64 junk
+ (base64-decode-region (point-min) (point-max) nil t))
((memq encoding '(nil 7bit 8bit binary))
;; Do nothing.
t)
diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el
index 8646998deb..8d31470634 100644
--- a/lisp/gnus/mm-uu.el
+++ b/lisp/gnus/mm-uu.el
@@ -194,7 +194,7 @@ This can be either \"inline\" or \"attachment\".")
nil)
(verbatim-marks
;; slrn-style verbatim marks, see
- ;;
http://slrn.sourceforge.net/docs/slrn-manual-6.html#process_verbatim_marks
+ ;;
https://slrn.sourceforge.net/docs/slrn-manual-6.html#process_verbatim_marks
"^#v\\+"
"^#v\\-$"
,(lambda () (mm-uu-verbatim-marks-extract 0 0))
diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index e8291cfe6f..ebd0adf2e2 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1446,7 +1446,7 @@ will be computed and used."
(mml-insert-empty-tag 'part
'type type
;; icicles redefines read-file-name and returns a
- ;; string w/ text properties :-/
+ ;; string with text properties :-/
'filename (substring-no-properties file)
'disposition (or disposition "attachment")
'description description)
diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el
index cdff7c9acc..378ada6247 100644
--- a/lisp/gnus/nndoc.el
+++ b/lisp/gnus/nndoc.el
@@ -23,7 +23,7 @@
;;; Commentary:
-;; For Outlook mail boxes format, see http://mbx2mbox.sourceforge.net/
+;; For Outlook mail boxes format, see https://mbx2mbox.sourceforge.net/
;;; Code:
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 73cd183a02..8392eb601f 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -238,7 +238,7 @@ during splitting, which may be slow."
(with-current-buffer (nnimap-buffer)
(erase-buffer)
;; If we have a lot of ranges, split them up to avoid
- ;; generating too-long lines. (The limit is 8192 octects,
+ ;; generating too-long lines. (The limit is 8192 octets,
;; and this should guarantee that it's (much) shorter than
;; that.) We don't stream the requests, since the server
;; may respond to the requests out-of-order:
diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el
index 99e7b2a6f3..66cee52865 100644
--- a/lisp/gnus/nnrss.el
+++ b/lisp/gnus/nnrss.el
@@ -77,7 +77,7 @@ this variable to the list of fields to be ignored.")
"List of RSS addresses.")
(defvar nnrss-use-local nil
- "If non-nil nnrss will read the feeds from local files in nnrss-directory.")
+ "If non-nil nnrss will read the feeds from local files in
`nnrss-directory'.")
(defvar nnrss-description-field 'X-Gnus-Description
"Field name used for DESCRIPTION.
@@ -398,7 +398,7 @@ otherwise return nil."
(declare-function libxml-parse-html-region "xml.c"
(start end &optional base-url discard-comments))
(defun nnrss-fetch (url &optional local)
- "Fetch URL and put it in a the expected Lisp structure."
+ "Fetch URL and put it in the expected Lisp structure."
(mm-with-unibyte-buffer
;;some versions of url.el need this to close the connection quickly
(let (cs xmlform htmlform)
@@ -800,7 +800,7 @@ It is useful when `(setq nnrss-use-local t)'."
node))
(defun nnrss-find-el (tag data &optional found-list)
- "Find the all matching elements in the data.
+ "Find all the matching elements in the data.
Careful with this on large documents!"
(when (consp data)
(dolist (bit data)
diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el
index e150cbf2b4..eec0347bcf 100644
--- a/lisp/gnus/nnvirtual.el
+++ b/lisp/gnus/nnvirtual.el
@@ -172,7 +172,7 @@ It is computed from the marks of individual component
groups.")
(with-current-buffer nntp-server-buffer
(erase-buffer)
(insert-buffer-substring vbuf)
- ;; FIX FIX FIX, we should be able to sort faster than
+ ;; FIXME: we should be able to sort faster than
;; this if needed, since each cgroup is sorted, we just
;; need to merge
(sort-numeric-fields 1 (point-min) (point-max))
diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el
index 7bb116d0c5..409befc242 100644
--- a/lisp/gnus/smime.el
+++ b/lisp/gnus/smime.el
@@ -152,7 +152,7 @@ certificate."
(defcustom smime-CA-file (car (gnutls-trustfiles))
"File containing certificates for CAs you trust.
The file should contain certificates in PEM format. By default,
-this is initialized from the `gnutls-trusfiles' variable."
+this is initialized from the `gnutls-trustfiles' variable."
:version "29.1"
:type '(choice (const :tag "none" nil)
file))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index eef895ae88..e29f763dab 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -669,7 +669,7 @@ the C sources, too."
"Insert usage at point and return docstring. With highlighting."
(if (keymapp function)
doc ; If definition is a keymap, skip arglist note.
- (let* ((advertised (gethash real-def advertised-signature-table t))
+ (let* ((advertised (get-advertised-calling-convention real-def))
(arglist (if (listp advertised)
advertised (help-function-arglist real-def)))
(usage (help-split-fundoc doc function)))
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
index 91c2a80400..cf024afe25 100644
--- a/lisp/help-macro.el
+++ b/lisp/help-macro.el
@@ -147,16 +147,16 @@ and then returns."
(while (or (memq char (append help-event-list
(cons help-char '( ?? ?\C-v ?\s
?\177 ?\M-v ?\S-\s
deletechar
backspace vertical-scroll-bar
- next prior
up down))))
+ home end
next prior up down))))
(eq (car-safe char) 'switch-frame)
(equal key "\M-v"))
(condition-case nil
(cond
((eq (car-safe char) 'switch-frame)
(handle-switch-frame char))
- ((memq char '(?\C-v ?\s next))
+ ((memq char '(?\C-v ?\s next end))
(scroll-up))
- ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar
backspace prior))
+ ((or (memq char '(?\177 ?\M-v ?\S-\s deletechar
backspace prior home))
(equal key "\M-v"))
(scroll-down))
((memq char '(down))
@@ -210,7 +210,11 @@ and then returns."
(unless (eq new-frame (selected-frame))
(iconify-frame new-frame))
(setq new-frame nil)))
- (ding)))))
+ (unless (equal (key-description key) "C-g")
+ (message (substitute-command-keys
+ (format "No help command is bound to `\\`%s''"
+ (key-description key))))
+ (ding))))))
(when config
(set-window-configuration config))
(when new-frame
diff --git a/lisp/help.el b/lisp/help.el
index b4b9120da3..f956111a52 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -55,66 +55,68 @@
This variable is bound to t during the preparation of a *Help*
buffer.")
-(defvar help-map
- (let ((map (make-sparse-keymap)))
- (define-key map (char-to-string help-char) 'help-for-help)
- (define-key map [help] 'help-for-help)
- (define-key map [f1] 'help-for-help)
- (define-key map "." 'display-local-help)
- (define-key map "?" 'help-for-help)
-
- (define-key map "\C-a" 'about-emacs)
- (define-key map "\C-c" 'describe-copying)
- (define-key map "\C-d" 'view-emacs-debugging)
- (define-key map "\C-e" 'view-external-packages)
- (define-key map "\C-f" 'view-emacs-FAQ)
- (define-key map "\C-m" 'view-order-manuals)
- (define-key map "\C-n" 'view-emacs-news)
- (define-key map "\C-o" 'describe-distribution)
- (define-key map "\C-p" 'view-emacs-problems)
- (define-key map "\C-s" 'search-forward-help-for-help)
- (define-key map "\C-t" 'view-emacs-todo)
- (define-key map "\C-w" 'describe-no-warranty)
-
- ;; This does not fit the pattern, but it is natural given the C-\ command.
- (define-key map "\C-\\" 'describe-input-method)
-
- (define-key map "C" 'describe-coding-system)
- (define-key map "F" 'Info-goto-emacs-command-node)
- (define-key map "I" 'describe-input-method)
- (define-key map "K" 'Info-goto-emacs-key-command-node)
- (define-key map "L" 'describe-language-environment)
- (define-key map "S" 'info-lookup-symbol)
-
- (define-key map "a" 'apropos-command)
- (define-key map "b" 'describe-bindings)
- (define-key map "c" 'describe-key-briefly)
- (define-key map "d" 'apropos-documentation)
- (define-key map "e" 'view-echo-area-messages)
- (define-key map "f" 'describe-function)
- (define-key map "g" 'describe-gnu-project)
- (define-key map "h" 'view-hello-file)
-
- (define-key map "i" 'info)
- (define-key map "4i" 'info-other-window)
-
- (define-key map "k" 'describe-key)
- (define-key map "l" 'view-lossage)
- (define-key map "m" 'describe-mode)
- (define-key map "o" 'describe-symbol)
- (define-key map "n" 'view-emacs-news)
- (define-key map "p" 'finder-by-keyword)
- (define-key map "P" 'describe-package)
- (define-key map "r" 'info-emacs-manual)
- (define-key map "R" 'info-display-manual)
- (define-key map "s" 'describe-syntax)
- (define-key map "t" 'help-with-tutorial)
- (define-key map "v" 'describe-variable)
- (define-key map "w" 'where-is)
- (define-key map "x" 'describe-command)
- (define-key map "q" 'help-quit)
- map)
- "Keymap for characters following the Help key.")
+(defun help-key ()
+ "Return `help-char' in a format suitable for the `keymap-set' KEY argument."
+ (key-description (char-to-string help-char)))
+
+(defvar-keymap help-map
+ :doc "Keymap for characters following the Help key."
+ (help-key) #'help-for-help
+ "<help>" #'help-for-help
+ "<f1>" #'help-for-help
+ "." #'display-local-help
+ "?" #'help-for-help
+
+ "C-a" #'about-emacs
+ "C-c" #'describe-copying
+ "C-d" #'view-emacs-debugging
+ "C-e" #'view-external-packages
+ "C-f" #'view-emacs-FAQ
+ "RET" #'view-order-manuals
+ "C-n" #'view-emacs-news
+ "C-o" #'describe-distribution
+ "C-p" #'view-emacs-problems
+ "C-s" #'search-forward-help-for-help
+ "C-t" #'view-emacs-todo
+ "C-w" #'describe-no-warranty
+
+ ;; This does not fit the pattern, but it is natural given the C-\ command.
+ "C-\\" #'describe-input-method
+
+ "C" #'describe-coding-system
+ "F" #'Info-goto-emacs-command-node
+ "I" #'describe-input-method
+ "K" #'Info-goto-emacs-key-command-node
+ "L" #'describe-language-environment
+ "S" #'info-lookup-symbol
+
+ "a" #'apropos-command
+ "b" #'describe-bindings
+ "c" #'describe-key-briefly
+ "d" #'apropos-documentation
+ "e" #'view-echo-area-messages
+ "f" #'describe-function
+ "g" #'describe-gnu-project
+ "h" #'view-hello-file
+
+ "i" #'info
+ "4 i" #'info-other-window
+
+ "k" #'describe-key
+ "l" #'view-lossage
+ "m" #'describe-mode
+ "o" #'describe-symbol
+ "n" #'view-emacs-news
+ "p" #'finder-by-keyword
+ "P" #'describe-package
+ "r" #'info-emacs-manual
+ "R" #'info-display-manual
+ "s" #'describe-syntax
+ "t" #'help-with-tutorial
+ "v" #'describe-variable
+ "w" #'where-is
+ "x" #'describe-command
+ "q" #'help-quit-or-quick)
(define-key global-map (char-to-string help-char) 'help-command)
(define-key global-map [help] 'help-command)
@@ -125,11 +127,146 @@ buffer.")
(defvar help-button-cache nil)
+
+(defvar help-quick-sections
+ '(("File"
+ (save-buffers-kill-terminal . "exit")
+ (find-file . "find")
+ (write-file . "write")
+ (save-buffer . "save")
+ (save-some-buffers . "all"))
+ ("Buffer"
+ (kill-buffer . "kill")
+ (list-buffers . "list")
+ (switch-to-buffer . "switch")
+ (goto-line . "goto line")
+ (read-only-mode . "read only"))
+ ("Window"
+ (delete-window . "only other")
+ (delete-other-windows . "only this")
+ (split-window-below . "split vert.")
+ (split-window-right . "split horiz.")
+ (other-window . "other window"))
+ ("Mark & Kill"
+ (set-mark-command . "mark")
+ (kill-line . "kill line")
+ (kill-ring-save . "kill region")
+ (yank . "yank")
+ (exchange-point-and-mark . "swap"))
+ ("Projects"
+ (project-switch-project . "switch")
+ (project-find-file . "find file")
+ (project-find-regexp . "search")
+ (project-query-replace-regexp . "search & replace")
+ (project-compile . "compile"))
+ ("Misc."
+ (undo . "undo")
+ (isearch-forward . "search")
+ (isearch-backward . "reverse search")
+ (query-replace . "search & replace")
+ (fill-paragraph . "reformat"))))
+
+(declare-function prop-match-value "text-property-search" (match))
+
+;; Inspired by a mg fork (https://github.com/troglobit/mg)
+(defun help-quick ()
+ "Display a quick-help buffer."
+ (interactive)
+ (with-current-buffer (get-buffer-create "*Quick Help*")
+ (let ((inhibit-read-only t) (padding 2) blocks)
+
+ ;; Go through every section and prepare a text-rectangle to be
+ ;; inserted later.
+ (dolist (section help-quick-sections)
+ (let ((max-key-len 0) (max-cmd-len 0) keys)
+ (dolist (ent (reverse (cdr section)))
+ (catch 'skip
+ (let* ((bind (where-is-internal (car ent) nil t))
+ (key (if bind
+ (propertize
+ (key-description bind)
+ 'face 'help-key-binding)
+ (throw 'skip nil))))
+ (setq max-cmd-len (max (length (cdr ent)) max-cmd-len)
+ max-key-len (max (length key) max-key-len))
+ (push (list key (cdr ent) (car ent)) keys))))
+ (when keys
+ (let ((fmt (format "%%-%ds %%-%ds%s" max-key-len max-cmd-len
+ (make-string padding ?\s)))
+ (width (+ max-key-len 1 max-cmd-len padding)))
+ (push `(,width
+ ,(propertize
+ (concat
+ (car section)
+ (make-string (- width (length (car section))) ?\s))
+ 'face 'bold)
+ ,@(mapcar (lambda (ent)
+ (format fmt
+ (propertize
+ (car ent)
+ 'quick-help-cmd
+ (caddr ent))
+ (cadr ent)))
+ keys))
+ blocks)))))
+
+ ;; Insert each rectangle in order until they don't fit into the
+ ;; frame any more, in which case the next sections are inserted
+ ;; in a new "line".
+ (erase-buffer)
+ (dolist (block (nreverse blocks))
+ (when (> (+ (car block) (current-column)) (frame-width))
+ (goto-char (point-max))
+ (newline 2))
+ (save-excursion
+ (insert-rectangle (cdr block)))
+ (end-of-line))
+ (delete-trailing-whitespace)
+
+ (save-excursion
+ (goto-char (point-min))
+ (while-let ((match (text-property-search-forward 'quick-help-cmd)))
+ (make-text-button (prop-match-beginning match)
+ (prop-match-end match)
+ 'mouse-face 'highlight
+ 'button t
+ 'keymap button-map
+ 'action #'describe-symbol
+ 'button-data (prop-match-value match)))))
+
+ (help-mode)
+
+ ;; Display the buffer at the bottom of the frame...
+ (with-selected-window (display-buffer-at-bottom (current-buffer) '())
+ ;; ... mark it as dedicated to prevent focus from being stolen
+ (set-window-dedicated-p (selected-window) t)
+ ;; ... and shrink it immediately.
+ (fit-window-to-buffer))
+ (message
+ (substitute-command-keys "Toggle the quick help buffer using
\\[help-quit-or-quick]."))))
+
+(defalias 'cheat-sheet #'help-quick)
+
(defun help-quit ()
"Just exit from the Help command's command loop."
(interactive)
nil)
+(defun help-quit-or-quick ()
+ "Call `help-quit' or `help-quick' depending on the context."
+ (interactive)
+ (cond
+ (help-buffer-under-preparation
+ ;; FIXME: There should be a better way to detect if we are in the
+ ;; help command loop.
+ (help-quit))
+ ((and-let* ((window (get-buffer-window "*Quick Help*")))
+ (quit-window t window)
+ ;; Clear the message we may have gotten from `C-h' and then
+ ;; waiting before hitting `q'.
+ (message "")))
+ ((help-quick))))
+
(defvar help-return-method nil
"What to do to \"exit\" the help buffer.
This is a list
@@ -279,6 +416,7 @@ Do not call this in the scope of `with-help-window'."
("describe-package" "Describe a specific Emacs package")
""
("help-with-tutorial" "Start the Emacs tutorial")
+ ("help-quick-or-quit" "Display the quick help buffer.")
("view-echo-area-messages"
"Show recent messages (from echo area)")
("view-lossage" ,(format "Show last %d input keystrokes (lossage)"
@@ -608,7 +746,8 @@ or a buffer name."
(setq-local outline-heading-end-regexp ":\n")
(setq-local outline-level (lambda () 1))
(setq-local outline-minor-mode-cycle t
- outline-minor-mode-highlight t)
+ outline-minor-mode-highlight t
+ outline-minor-mode-use-buttons 'insert)
(outline-minor-mode 1)
(save-excursion
(goto-char (point-min))
@@ -1806,10 +1945,7 @@ of a horizontal combination, restrain its new size by
`fit-window-to-buffer-horizontally' can inhibit resizing.
If WINDOW is the root window of its frame, resize the frame
-provided `fit-frame-to-buffer' is non-nil.
-
-This function may call `preserve-window-size' to preserve the
-size of WINDOW."
+provided `fit-frame-to-buffer' is non-nil."
(setq window (window-normalize-window window t))
(let* ((buffer (window-buffer window))
(height (if (functionp temp-buffer-max-height)
diff --git a/lisp/hl-line.el b/lisp/hl-line.el
index 693c94eea8..87bea1017f 100644
--- a/lisp/hl-line.el
+++ b/lisp/hl-line.el
@@ -156,7 +156,8 @@ line about point in the selected window only."
:group 'hl-line
;; If the global mode is switched on, then `M-x hl-line-mode' should
;; switch the mode off in this buffer.
- (when global-hl-line-mode
+ (when (and global-hl-line-mode
+ (eq arg 'toggle))
(setq hl-line-mode nil)
(setq-local global-hl-line-mode nil)
(global-hl-line-unhighlight))
diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index b1fdbd2c4a..df4c6ab079 100644
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1539,33 +1539,13 @@ See also `hfy-html-enkludge-buffer'."
(if (get-text-property (match-beginning 0) 'hfy-quoteme)
(replace-match (hfy-html-quote (match-string 1))) )) ))
-;; Borrowed from font-lock.el
-(defmacro hfy-save-buffer-state (varlist &rest body)
- "Bind variables according to VARLIST and eval BODY restoring buffer state.
-Do not record undo information during evaluation of BODY."
- (declare (indent 1) (debug let))
- (let ((modified (make-symbol "modified")))
- `(let* ,(append varlist
- `((,modified (buffer-modified-p))
- (buffer-undo-list t)
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- deactivate-mark
- buffer-file-name
- buffer-file-truename))
- (progn
- ,@body)
- (unless ,modified
- (restore-buffer-modified-p nil)))))
-
(defun hfy-mark-trailing-whitespace ()
"Tag trailing whitespace with a hfy property if it is currently highlighted."
(when show-trailing-whitespace
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-min))
- (hfy-save-buffer-state nil
+ (with-silent-modifications
(while (re-search-forward "[ \t]+$" nil t)
(put-text-property (match-beginning 0) (match-end 0)
'hfy-show-trailing-whitespace t)))))))
@@ -1573,7 +1553,7 @@ Do not record undo information during evaluation of BODY."
(defun hfy-unmark-trailing-whitespace ()
"Undo the effect of `hfy-mark-trailing-whitespace'."
(when show-trailing-whitespace
- (hfy-save-buffer-state nil
+ (with-silent-modifications
(remove-text-properties (point-min) (point-max)
'(hfy-show-trailing-whitespace nil)))))
@@ -1957,7 +1937,7 @@ Otherwise, the link should be to the index file.
We are not yet concerned with the file extensions/tag line number and so on at
this point.
-If `hfy-split-index' is set, and the href wil be to an index file rather than
+If `hfy-split-index' is set, and the href will be to an index file rather than
a source file, append a .X to `hfy-index-file', where X is the uppercased
first character of TAG.
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index 19afdaa278..ef710d582d 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -139,7 +139,7 @@ See `icomplete-delay-completions-threshold'."
(defvar icomplete-in-buffer nil
"If non-nil, also use Icomplete when completing in non-mini buffers.
-This affects commands like `complete-in-region', but not commands
+This affects commands like `completion-in-region', but not commands
that use their own completions setup.")
(defcustom icomplete-minibuffer-setup-hook nil
@@ -228,7 +228,7 @@ the default otherwise."
;; Apropos `icomplete-scroll', we implement "scrolling icomplete"
;; within classic icomplete, which is "rotating", by contrast.
;;
-;; The two variables supporing this are
+;; The two variables supporting this are
;; `icomplete--scrolled-completions' and `icomplete--scrolled-past'.
;; They come into play when:
;;
diff --git a/lisp/ido.el b/lisp/ido.el
index 1d0082da97..77e4dd447d 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -3915,7 +3915,7 @@ If `ido-change-word-sub' cannot be found in WORD, return
nil."
"Return dotted pair (RES . 1)."
(cons res 1))
-(defun ido-choose-completion-string (choice &rest ignored)
+(defun ido-choose-completion-string (choice &rest _ignored)
(when (ido-active)
;; Insert the completion into the buffer where completion was requested.
(and ido-completion-buffer
diff --git a/lisp/image/image-dired-external.el
b/lisp/image/image-dired-external.el
index 026a84560d..b1f8a6c228 100644
--- a/lisp/image/image-dired-external.el
+++ b/lisp/image/image-dired-external.el
@@ -216,7 +216,7 @@ Each item has the form (ORIGINAL-FILE TARGET-FILE).")
"Maximum number of concurrent jobs permitted for generating images.
Increase at own risk. If you want to experiment with this,
consider setting `image-dired-debug' to a non-nil value to see
-the time spent on generating thumbnails. Run `image-clear-cache'
+the time spent on generating thumbnails. Run `clear-image-cache'
and remove the cached thumbnail files between each trial run.")
(defun image-dired-pngnq-thumb (spec)
diff --git a/lisp/image/wallpaper.el b/lisp/image/wallpaper.el
index e23b65d616..f083477ddf 100644
--- a/lisp/image/wallpaper.el
+++ b/lisp/image/wallpaper.el
@@ -26,7 +26,8 @@
;; desktop background.
;;
;; On GNU/Linux and other Unix-like systems, it uses an external
-;; command to set the desktop background.
+;; command to set the desktop background. This should work seamlessly
+;; on both X and Wayland.
;;
;; Finding an external command to use is obviously a bit tricky to get
;; right, as there is no lack of platforms, window managers, desktop
@@ -94,9 +95,11 @@ the image file to set the wallpaper to.")
(args (if (or (listp args-raw) (symbolp args-raw))
args-raw
(string-split args-raw)))
- (predicate (plist-get rest-plist :predicate))))
+ (predicate (plist-get rest-plist :predicate))
+ (init-action (plist-get rest-plist :init-action))
+ (detach (plist-get rest-plist :detach))))
(:copier wallpaper-setter-copy))
- "Structure containing a command to set the wallpaper.
+ "Structure containing a method to set the wallpaper.
NAME is a description of the setter (e.g. the name of the Desktop
Environment).
@@ -106,15 +109,41 @@ COMMAND is the executable to run to set the wallpaper.
ARGS is the default list of command line arguments for COMMAND.
PREDICATE is a function that will be called without any arguments
-and returns non-nil if this setter should be used."
+and returns non-nil if this setter should be used.
+
+INIT-ACTION is a function that will be called without any
+arguments before trying to set the wallpaper.
+
+DETACH, if non-nil, means that the wallpaper process should
+continue running even after exiting Emacs."
name
command
args
- (predicate #'always))
+ (predicate #'always)
+ init-action
+ detach)
;;;###autoload
(put 'wallpaper-setter-create 'lisp-indent-function 1)
+(defun wallpaper--init-action-kill (process-name)
+ "Return kill function for `init-action' of a `wallpaper-setter' structure.
+The returned function kills any process named PROCESS-NAME owned
+by the current effective user id."
+ (lambda ()
+ (when-let ((procs
+ (seq-filter (lambda (p) (let-alist p
+ (and (= .euid (user-uid))
+ (equal .comm process-name))))
+ (mapcar (lambda (pid)
+ (cons (cons 'pid pid)
+ (process-attributes pid)))
+ (list-system-processes)))))
+ (dolist (proc procs)
+ (let-alist proc
+ (when (y-or-n-p (format "Kill \"%s\" process with PID %d?" .comm
.pid))
+ (signal-process .pid 'TERM)))))))
+
(defmacro wallpaper--default-methods-create (&rest items)
"Helper macro for defining `wallpaper--default-setters'."
(cons 'list
@@ -198,12 +227,16 @@ and returns non-nil if this setter should be used."
"swaybg" "-o * -i %f -m fill"
:predicate (lambda ()
(and (getenv "WAYLAND_DISPLAY")
- (getenv "SWAYSOCK"))))
+ (getenv "SWAYSOCK")))
+ :init-action (wallpaper--init-action-kill "swaybg")
+ :detach t)
("wbg"
"wbg" "%f"
:predicate (lambda ()
- (getenv "WAYLAND_DISPLAY")))
+ (getenv "WAYLAND_DISPLAY"))
+ :init-action (wallpaper--init-action-kill "wbg")
+ :detach t)
;; X general.
("GraphicsMagick"
@@ -257,7 +290,8 @@ order in which they appear.")
(defun wallpaper--find-setter ()
(when (wallpaper--use-default-set-function-p)
- (or wallpaper--current-setter
+ (or (and (wallpaper-setter-p wallpaper--current-setter)
+ wallpaper--current-setter)
(setq wallpaper--current-setter
(catch 'found
(dolist (setter wallpaper--default-setters)
@@ -440,9 +474,10 @@ FILE is the image file name."
(format-spec
format
`((?f . ,(expand-file-name file))
- (?F . ,(mapconcat #'url-hexify-string
- (file-name-split file)
- "/"))
+ (?F . ,(lambda ()
+ (mapconcat #'url-hexify-string
+ (file-name-split file)
+ "/")))
(?h . ,(lambda ()
(wallpaper--get-height-or-width
"height"
@@ -454,22 +489,25 @@ FILE is the image file name."
#'display-pixel-width
wallpaper-default-width)))
;; screen number
- (?S . ,(let ((display (frame-parameter (selected-frame) 'display)))
- (if (and display
- (string-match (rx ":" (+ (in "0-9")) "."
- (group (+ (in "0-9"))) eos)
- display))
- (match-string 1 display)
- "0")))
+ (?S . ,(lambda ()
+ (let ((display (frame-parameter (selected-frame) 'display)))
+ (if (and display
+ (string-match (rx ":" (+ (in "0-9")) "."
+ (group (+ (in "0-9"))) eos)
+ display))
+ (match-string 1 display)
+ "0"))))
;; monitor name
(?M . ,#'wallpaper--x-monitor-name)
;; workspace
- (?W . ,(or (and (fboundp 'x-window-property)
- (display-graphic-p)
- (number-to-string
- (or (x-window-property "_NET_CURRENT_DESKTOP" nil
"CARDINAL" 0 nil t)
- (x-window-property "WIN_WORKSPACE" nil "CARDINAL" 0
nil t))))
- "0")))))
+ (?W . ,(lambda ()
+ (or (and (fboundp 'x-window-property)
+ (display-graphic-p)
+ (number-to-string
+ (or (x-window-property "_NET_CURRENT_DESKTOP" nil
"CARDINAL" 0 nil t)
+ (x-window-property "WIN_WORKSPACE" nil "CARDINAL"
0 nil t)
+ 0)))
+ "0"))))))
(defun wallpaper-default-set-function (file)
"Set the wallpaper to FILE using a command.
@@ -482,28 +520,36 @@ This is the default function for
`wallpaper-set-function'."
(real-args (mapcar (lambda (arg) (wallpaper--format-arg arg file))
args))
(bufname (format " *wallpaper-%s*" (random)))
- (process
- (and wallpaper-command
- (apply #'start-process "set-wallpaper" bufname
- wallpaper-command real-args))))
- (unless wallpaper-command
- (error "Couldn't find a suitable command for setting the wallpaper"))
+ (setter (and (wallpaper-setter-p wallpaper--current-setter)
+ (equal (wallpaper-setter-command
wallpaper--current-setter)
+ wallpaper-command)
+ wallpaper--current-setter))
+ (init-action (and setter (wallpaper-setter-init-action setter)))
+ (detach (and setter (wallpaper-setter-detach setter)))
+ process)
+ (when init-action
+ (funcall init-action))
(wallpaper-debug "Using command: \"%s %s\""
- wallpaper-command (string-join real-args " "))
- (setf (process-sentinel process)
- (lambda (process status)
- (unwind-protect
- (if (and (eq (process-status process) 'exit)
- (zerop (process-exit-status process)))
- (message "Desktop wallpaper changed to %s"
- (abbreviate-file-name file))
- (message "command \"%s %s\": %S"
- (string-join (process-command process) " ")
- (string-replace "\n" "" status)
- (with-current-buffer (process-buffer process)
- (string-clean-whitespace (buffer-string)))))
- (ignore-errors
- (kill-buffer (process-buffer process))))))
+ wallpaper-command (string-join real-args " "))
+ (if detach
+ (apply #'call-process wallpaper-command nil 0 nil real-args)
+ (setq process
+ (apply #'start-process "set-wallpaper" bufname
+ wallpaper-command real-args))
+ (setf (process-sentinel process)
+ (lambda (process status)
+ (unwind-protect
+ (if (and (eq (process-status process) 'exit)
+ (zerop (process-exit-status process)))
+ (message "Desktop wallpaper changed to %s"
+ (abbreviate-file-name file))
+ (message "command \"%s %s\": %S"
+ (string-join (process-command process) " ")
+ (string-replace "\n" "" status)
+ (with-current-buffer (process-buffer process)
+ (string-clean-whitespace (buffer-string)))))
+ (ignore-errors
+ (kill-buffer (process-buffer process)))))))
process))
;;;###autoload
diff --git a/lisp/info-look.el b/lisp/info-look.el
index ce0a08dcbe..2eec6f49f5 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -1051,6 +1051,7 @@ Return nil if there is nothing appropriate in the buffer
near point."
("eieio" "Function Index")
("gnutls" "(emacs-gnutls)Variable Index" "(emacs-gnutls)Function Index")
("mm" "(emacs-mime)Index")
+ ("eglot" "Index")
("epa" "Variable Index" "Function Index")
("ert" "Index")
("eshell" "Function and Variable Index")
diff --git a/lisp/info.el b/lisp/info.el
index 292bf93a6f..8860a664bd 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -763,6 +763,11 @@ See a list of available Info commands in `Info-mode'."
(read-file-name "Info file name: " nil nil t))
(if (numberp current-prefix-arg)
(format "*info*<%s>" current-prefix-arg))))
+ (when file-or-node
+ ;; Info node names don't contain newlines, so allow for easier use
+ ;; of names that might have been wrapped (in emails, etc.).
+ (setq file-or-node
+ (string-replace "\n" " " file-or-node)))
(info-setup file-or-node
(pop-to-buffer-same-window (or buffer "*info*"))))
@@ -1878,6 +1883,9 @@ See `completing-read' for a description of arguments and
usage."
(t (complete-with-action
code Info-read-node-completion-table string predicate))))
+(defvar Info-minibuf-history nil
+ "History for `Info-read-node-name'.")
+
;; Arrange to highlight the proper letters in the completion list buffer.
(defun Info-read-node-name (prompt &optional default)
"Read an Info node name with completion, prompting with PROMPT.
@@ -2476,7 +2484,6 @@ Table of contents is created from the tree structure of
menus."
(sections '(("Top" "Top")))
nodes subfiles)
(while (or main-file subfiles)
- ;; (or main-file (message "Searching subfile %s..." (car subfiles)))
(erase-buffer)
(info-insert-file-contents (or main-file (car subfiles)))
(goto-char (point-min))
@@ -2535,7 +2542,6 @@ Table of contents is created from the tree structure of
menus."
(setq subfiles (nreverse subfiles)
main-file nil))
(setq subfiles (cdr subfiles))))
- (message "")
(nreverse nodes))))
(defun Info-toc-nodes (filename)
@@ -2660,7 +2666,7 @@ new buffer."
(defconst Info-menu-entry-name-re "\\(?:[^:]\\|:[^:,.;() \t\n]\\)*"
;; We allow newline because this is also used in Info-follow-reference,
;; where the xref name might be wrapped over two lines.
- "Regexp that matches a menu entry name upto but not including the colon.
+ "Regexp that matches a menu entry name up to but not including the colon.
Because of ambiguities, this should be concatenated with something like
`:' and `Info-following-node-name-re'.")
diff --git a/lisp/international/emoji.el b/lisp/international/emoji.el
index 4f4d4f4832..3d065b778e 100644
--- a/lisp/international/emoji.el
+++ b/lisp/international/emoji.el
@@ -552,8 +552,7 @@ the name is not known."
(apply (or class 'transient-prefix) :command name
(cons :variable-pitch (cons t slots))))
(put name 'transient--layout
- (cl-mapcan (lambda (s) (transient--parse-child name s))
- suffixes)))
+ (transient-parse-suffixes name suffixes)))
name))
(defun emoji--recent-transient (end-function)
diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 6e44b85e6c..93fedb8c1a 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -152,7 +152,7 @@
'((latin ?A ?Z ?a ?z #x00C0 #x0100 #x0180 #x1e00)
(phonetic #x250 #x283)
(greek #x3A9)
- (coptic #x3E2)
+ (coptic #x3E2 #x2C80 #x2CAE)
(cyrillic #x42F)
(armenian #x531)
(hebrew #x5D0)
@@ -779,6 +779,7 @@
lepcha
symbol
braille
+ coptic
yi
syloti-nagri
rejang
diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el
index 48e5c9aa1f..61a26b504c 100644
--- a/lisp/international/mule-cmds.el
+++ b/lisp/international/mule-cmds.el
@@ -1208,6 +1208,16 @@ Arguments are the same as `set-language-info'."
(list 'const lang))
(sort (mapcar 'car language-info-alist) 'string<))))))
+(defun set-language-info-setup-keymap (lang-env alist describe-map setup-map)
+ "Setup menu items for LANG-ENV.
+See `set-language-info-alist' for details of other arguments."
+ (let ((doc (assq 'documentation alist)))
+ (when doc
+ (define-key-after describe-map (vector (intern lang-env))
+ (cons lang-env 'describe-specified-language-support))))
+ (define-key-after setup-map (vector (intern lang-env))
+ (cons lang-env 'setup-specified-language-environment)))
+
(defun set-language-info-alist (lang-env alist &optional parents)
"Store ALIST as the definition of language environment LANG-ENV.
ALIST is an alist of KEY and INFO values. See the documentation of
@@ -1222,51 +1232,44 @@ in the European submenu in each of those two menus."
(setq lang-env (symbol-name lang-env)))
((stringp lang-env)
(setq lang-env (purecopy lang-env))))
- (let ((describe-map describe-language-environment-map)
- (setup-map setup-language-environment-map))
- (if parents
- (let ((l parents)
- map parent-symbol parent prompt)
- (while l
- (if (symbolp (setq parent-symbol (car l)))
- (setq parent (symbol-name parent))
- (setq parent parent-symbol parent-symbol (intern parent)))
- (setq map (lookup-key describe-map (vector parent-symbol)))
- ;; This prompt string is for define-prefix-command, so
- ;; that the map it creates will be suitable for a menu.
- (or map (setq prompt (format "%s Environment" parent)))
- (if (not map)
- (progn
- (setq map (intern (format "describe-%s-environment-map"
- (downcase parent))))
- (define-prefix-command map nil prompt)
- (define-key-after describe-map (vector parent-symbol)
- (cons parent map))))
- (setq describe-map (symbol-value map))
- (setq map (lookup-key setup-map (vector parent-symbol)))
- (if (not map)
- (progn
- (setq map (intern (format "setup-%s-environment-map"
- (downcase parent))))
- (define-prefix-command map nil prompt)
- (define-key-after setup-map (vector parent-symbol)
- (cons parent map))))
- (setq setup-map (symbol-value map))
- (setq l (cdr l)))))
-
- ;; Set up menu items for this language env.
- (let ((doc (assq 'documentation alist)))
- (when doc
- (define-key-after describe-map (vector (intern lang-env))
- (cons lang-env 'describe-specified-language-support))))
- (define-key-after setup-map (vector (intern lang-env))
- (cons lang-env 'setup-specified-language-environment))
-
- (dolist (elt alist)
- (set-language-info-internal lang-env (car elt) (cdr elt)))
-
- (if (equal lang-env current-language-environment)
- (set-language-environment lang-env))))
+ (if parents
+ (while parents
+ (let (describe-map setup-map parent-symbol parent prompt)
+ (if (symbolp (setq parent-symbol (car parents)))
+ (setq parent (symbol-name parent))
+ (setq parent parent-symbol parent-symbol (intern parent)))
+ (setq describe-map (lookup-key describe-language-environment-map
+ (vector parent-symbol)))
+ ;; This prompt string is for define-prefix-command, so
+ ;; that the map it creates will be suitable for a menu.
+ (or describe-map (setq prompt (format "%s Environment" parent)))
+ (unless describe-map
+ (setq describe-map (intern (format "describe-%s-environment-map"
+ (downcase parent))))
+ (define-prefix-command describe-map nil prompt)
+ (define-key-after
+ describe-language-environment-map
+ (vector parent-symbol) (cons parent describe-map)))
+ (setq setup-map (lookup-key setup-language-environment-map
+ (vector parent-symbol)))
+ (unless setup-map
+ (setq setup-map (intern (format "setup-%s-environment-map"
+ (downcase parent))))
+ (define-prefix-command setup-map nil prompt)
+ (define-key-after
+ setup-language-environment-map
+ (vector parent-symbol) (cons parent setup-map)))
+ (setq parents (cdr parents))
+ (set-language-info-setup-keymap
+ lang-env alist
+ (symbol-value describe-map) (symbol-value setup-map))))
+ (set-language-info-setup-keymap
+ lang-env alist
+ describe-language-environment-map setup-language-environment-map))
+ (dolist (elt alist)
+ (set-language-info-internal lang-env (car elt) (cdr elt)))
+ (if (equal lang-env current-language-environment)
+ (set-language-environment lang-env)))
(defun read-language-name (key prompt &optional default)
"Read a language environment name which has information for KEY.
diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el
index cdf2e527e2..6e49c9cb21 100644
--- a/lisp/international/mule-diag.el
+++ b/lisp/international/mule-diag.el
@@ -812,7 +812,7 @@ but still contains full information about each coding
system."
(declare-function font-info "font.c" (name &optional frame))
-(defun describe-font-internal (font-info &optional ignored)
+(defun describe-font-internal (font-info &optional _ignored)
"Print information about a font in FONT-INFO.
The IGNORED argument is ignored."
(print-list "name (opened by):" (aref font-info 0))
diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el
index 82eba1b5d5..f8ff89c314 100644
--- a/lisp/international/textsec.el
+++ b/lisp/international/textsec.el
@@ -156,7 +156,7 @@ Levels are (in decreasing order of restrictiveness)
`ascii-only',
tibetan)))
;; The string is covered by Latin and any one other Recommended
;; script, except Cyrillic, Greek.
- 'moderately-retrictive)
+ 'moderately-restrictive)
;; Fixme `minimally-restrictive' -- needs well-formedness criteria
;; and Identifier Profile.
(t
diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el
index d2a6ee1e9d..b942f5fabc 100644
--- a/lisp/international/titdic-cnv.el
+++ b/lisp/international/titdic-cnv.el
@@ -59,6 +59,13 @@
;; Near the end of this file, we also have a few other tools to convert
;; miscellaneous dictionaries.
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(require 'quail)
diff --git a/lisp/isearch.el b/lisp/isearch.el
index 3e840b014f..bc3697deb0 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -3649,8 +3649,7 @@ Optional third argument, if t, means if fail just return
nil (no error).
(setq isearch-case-fold-search
(isearch-no-upper-case-p isearch-string isearch-regexp)))
(condition-case lossage
- (let ((inhibit-point-motion-hooks isearch-invisible)
- (inhibit-quit nil)
+ (let ((inhibit-quit nil)
(case-fold-search isearch-case-fold-search)
(search-invisible isearch-invisible)
(retry t))
diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el
index 6ef46ad60b..ed7a3dbba3 100644
--- a/lisp/jit-lock.el
+++ b/lisp/jit-lock.el
@@ -27,16 +27,6 @@
;;; Code:
-
-(eval-when-compile
- (defmacro with-buffer-prepared-for-jit-lock (&rest body)
- "Execute BODY in current buffer, overriding several variables.
-Preserves the `buffer-modified-p' state of the current buffer."
- (declare (debug t))
- `(let ((inhibit-point-motion-hooks t))
- (with-silent-modifications
- ,@body))))
-
;;; Customization.
(defgroup jit-lock nil
@@ -328,7 +318,7 @@ like `debug-on-error' and Edebug can be used."
(when (buffer-live-p buffer)
(with-current-buffer buffer
;; (message "Jit-Debug %s" (buffer-name))
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(let ((pos (point-min)))
(while
(progn
@@ -365,7 +355,7 @@ Only applies to the current buffer."
(defun jit-lock-refontify (&optional beg end)
"Force refontification of the region BEG..END (default whole buffer)."
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(save-restriction
(widen)
(put-text-property (or beg (point-min)) (or end (point-max))
@@ -392,7 +382,7 @@ is active."
(push (current-buffer) jit-lock-defer-buffers))
;; Mark the area as defer-fontified so that the redisplay engine
;; is happy and so that the idle timer can find the places to fontify.
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(put-text-property start
(next-single-property-change
start 'fontified nil
@@ -426,7 +416,7 @@ is active."
(defun jit-lock-fontify-now (&optional start end)
"Fontify current buffer from START to END.
Defaults to the whole buffer. END can be out of bounds."
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(save-excursion
(unless start (setq start (point-min)))
(setq end (if end (min end (point-max)) (point-max)))
@@ -502,7 +492,7 @@ Defaults to the whole buffer. END can be out of bounds."
This applies to the buffer associated with marker START."
(when (marker-buffer start)
(with-current-buffer (marker-buffer start)
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(when (> end (point-max))
(setq end (point-max) start (min start end)))
(when (< start (point-min))
@@ -616,7 +606,7 @@ non-nil in a repeated invocation of this function."
(when (buffer-live-p buffer)
(with-current-buffer buffer
;; (message "Jit-Defer %s" (buffer-name))
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(let ((pos (point-min)))
(while
(progn
@@ -664,7 +654,7 @@ non-nil in a repeated invocation of this function."
jit-lock-context-unfontify-pos
'jit-lock-defer-multiline)
(point-min))))
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
;; Force contextual refontification.
(remove-text-properties
jit-lock-context-unfontify-pos (point-max)
@@ -695,7 +685,7 @@ will take place when text is fontified stealthily."
(when (and jit-lock-mode (not memory-full))
(let ((jit-lock-start start)
(jit-lock-end end))
- (with-buffer-prepared-for-jit-lock
+ (with-silent-modifications
(run-hook-with-args 'jit-lock-after-change-extend-region-functions
start end old-len)
;; Make sure we change at least one char (in case of deletions).
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
index 8db78ebcda..420d83ab1f 100644
--- a/lisp/jka-compr.el
+++ b/lisp/jka-compr.el
@@ -598,7 +598,7 @@ There should be no more than seven characters after the
final `/'."
;; Support for loading compressed files.
-(defun jka-compr-load (file &optional noerror nomessage _nosuffix)
+(defun jka-compr-load (file &optional noerror nomessage _nosuffix _must-suffix)
"Documented as original."
(let* ((local-copy (jka-compr-file-local-copy file))
diff --git a/lisp/keymap.el b/lisp/keymap.el
index 107565590c..eaeba96644 100644
--- a/lisp/keymap.el
+++ b/lisp/keymap.el
@@ -559,22 +559,45 @@ In addition to the keywords accepted by `define-keymap',
this
macro also accepts a `:doc' keyword, which (if present) is used
as the variable documentation string.
-\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY
DEFINITION]...)"
+The `:repeat' keyword can also be specified; it controls the
+`repeat-mode' behavior of the bindings in the keymap. When it is
+non-nil, all commands in the map will have the `repeat-map'
+symbol property.
+
+More control is available over which commands are repeatable; the
+value can also be a property list with properties `:enter' and
+`:exit', for example:
+
+ :repeat (:enter (commands ...) :exit (commands ...))
+
+`:enter' specifies the list of additional commands that only
+enter `repeat-mode'. When the list is empty, then by default all
+commands in the map enter `repeat-mode'. This is useful when
+there is a command that has the `repeat-map' symbol property, but
+doesn't exist in this specific map. `:exit' is a list of
+commands that exit `repeat-mode'. When the list is empty, no
+commands in the map exit `repeat-mode'. This is useful when a
+command exists in this specific map, but it doesn't have the
+`repeat-map' symbol property on its symbol.
+
+\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP REPEAT
&rest [KEY DEFINITION]...)"
(declare (indent 1))
(let ((opts nil)
- doc)
+ doc repeat props)
(while (and defs
(keywordp (car defs))
(not (eq (car defs) :menu)))
(let ((keyword (pop defs)))
(unless defs
(error "Uneven number of keywords"))
- (if (eq keyword :doc)
- (setq doc (pop defs))
- (push keyword opts)
- (push (pop defs) opts))))
+ (cond
+ ((eq keyword :doc) (setq doc (pop defs)))
+ ((eq keyword :repeat) (setq repeat (pop defs)))
+ (t (push keyword opts)
+ (push (pop defs) opts)))))
(unless (zerop (% (length defs) 2))
(error "Uneven number of key/definition pairs: %s" defs))
+
(let ((defs defs)
key seen-keys)
(while defs
@@ -585,9 +608,28 @@ as the variable documentation string.
(error "Duplicate definition for key '%s' in keymap '%s'"
key variable-name)
(push key seen-keys)))))
- `(defvar ,variable-name
- (define-keymap ,@(nreverse opts) ,@defs)
- ,@(and doc (list doc)))))
+
+ (when repeat
+ (let ((defs defs)
+ def)
+ (dolist (def (plist-get repeat :enter))
+ (push `(put ',def 'repeat-map ',variable-name) props))
+ (while defs
+ (pop defs)
+ (setq def (pop defs))
+ (when (and (memq (car def) '(function quote))
+ (not (memq (cadr def) (plist-get repeat :exit))))
+ (push `(put ,def 'repeat-map ',variable-name) props)))))
+
+ (let ((defvar-form
+ `(defvar ,variable-name
+ (define-keymap ,@(nreverse opts) ,@defs)
+ ,@(and doc (list doc)))))
+ (if repeat
+ `(progn
+ ,defvar-form
+ ,@(nreverse props))
+ defvar-form))))
(defun make-non-key-event (symbol)
"Mark SYMBOL as an event that shouldn't be returned from `where-is'."
diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el
index 2f76acfe7c..5b4252d779 100644
--- a/lisp/language/ethio-util.el
+++ b/lisp/language/ethio-util.el
@@ -30,6 +30,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(require 'robin)
@@ -105,6 +112,8 @@
(defcustom ethio-primary-language 'tigrigna
"Symbol that defines the primary language in SERA --> FIDEL conversion.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The value should be one of: `tigrigna', `amharic' or `english'."
:version "28.1"
:type '(choice (const :tag "Tigrigna" tigrigna)
@@ -113,6 +122,8 @@ The value should be one of: `tigrigna', `amharic' or
`english'."
(defcustom ethio-secondary-language 'english
"Symbol that defines the secondary language in SERA --> FIDEL conversion.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The value should be one of: `tigrigna', `amharic' or `english'."
:version "28.1"
:type '(choice (const :tag "Tigrigna" tigrigna)
@@ -123,7 +134,9 @@ The value should be one of: `tigrigna', `amharic' or
`english'."
"Non-nil means associate ASCII colon with Ethiopic colon.
If nil, associate ASCII colon with Ethiopic word separator, i.e., two
vertically stacked dots. All SERA <--> FIDEL converters refer this
-variable."
+variable.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
:version "28.1"
:type 'boolean)
@@ -131,7 +144,9 @@ variable."
"If non-nil, associate ASCII question mark with Ethiopic question mark.
The Ethiopic old style question mark is three vertically stacked dots.
If nil, associate ASCII question mark with Ethiopic stylized question
-mark. All SERA <--> FIDEL converters refer this variable."
+mark. All SERA <--> FIDEL converters refer this variable.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
:version "28.1"
:type 'boolean)
@@ -140,13 +155,17 @@ mark. All SERA <--> FIDEL converters refer this
variable."
This happens in FIDEL --> SERA conversions. Isolated vowels at
word beginning do not get an apostrophe put before them.
If nil, put an apostrophe only between a 6th-form consonant and an
-isolated vowel."
+isolated vowel.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
:version "28.1"
:type 'boolean)
(defcustom ethio-W-sixth-always nil
"Non-nil means convert the Wu-form of a 12-form consonant to \"W'\".
-This is instead of \"Wu\" in FIDEL --> SERA conversion."
+This is instead of \"Wu\" in FIDEL --> SERA conversion.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
:version "28.1"
:type 'boolean)
@@ -216,6 +235,8 @@ If nil, use uppercases."
(defun ethio-sera-to-fidel-buffer (&optional secondary force)
"Convert the current buffer from SERA to FIDEL.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The variable `ethio-primary-language' specifies the primary
language and `ethio-secondary-language' specifies the secondary.
@@ -241,6 +262,8 @@ See also the descriptions of the variables
(defun ethio-sera-to-fidel-region (begin end &optional secondary force)
"Convert the characters in region from SERA to FIDEL.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The variable `ethio-primary-language' specifies the primary
language and `ethio-secondary-language' specifies the secondary.
@@ -496,7 +519,9 @@ changing anything."
;;;###autoload
(defun ethio-sera-to-fidel-marker (&optional force)
- "Convert the regions surrounded by \"<sera>\" and \"</sera>\" from SERA to
FIDEL.
+ "Convert regions surrounded by \"<sera>\" and \"</sera>\" from SERA to FIDEL.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
Assume that each region begins with `ethio-primary-language'.
The markers \"<sera>\" and \"</sera>\" themselves are not deleted."
(interactive "P")
@@ -528,7 +553,9 @@ The markers \"<sera>\" and \"</sera>\" themselves are not
deleted."
;;;###autoload
(defun ethio-fidel-to-sera-buffer (&optional secondary force)
- "Replace all the FIDEL characters in the current buffer to the SERA format.
+ "Convert all the FIDEL characters in the current buffer to the SERA format.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The variable `ethio-primary-language' specifies the primary
language and `ethio-secondary-language' specifies the secondary.
@@ -548,8 +575,10 @@ See also the descriptions of the variables
;;;###autoload
(defun ethio-fidel-to-sera-region (begin end &optional secondary force)
- "Replace all the FIDEL characters in the region to the SERA format.
+ "Convert all the FIDEL characters in the region to the SERA format.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The variable `ethio-primary-language' specifies the primary
language and `ethio-secondary-language' specifies the secondary.
@@ -667,6 +696,8 @@ See also the descriptions of the variables
;;;###autoload
(defun ethio-fidel-to-sera-marker (&optional force)
"Convert the regions surrounded by \"<sera>\" and \"</sera>\" from FIDEL to
SERA.
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script.
The markers \"<sera>\" and \"</sera>\" themselves are not deleted."
(interactive "P")
@@ -691,7 +722,8 @@ The markers \"<sera>\" and \"</sera>\" themselves are not
deleted."
;;;###autoload
(defun ethio-modify-vowel nil
- "Modify the vowel of the FIDEL that is under the cursor."
+ "Modify the vowel of the FIDEL that is under the cursor.
+FIDEL is the Amharic/Ethiopic alphabet."
(interactive)
(ethio-adjust-robin)
(let ((consonant (ethio-get-consonant (following-char)))
@@ -708,7 +740,9 @@ The markers \"<sera>\" and \"</sera>\" themselves are not
deleted."
(robin-convert-region (point-min) (point-max) "ethiopic-sera"))))))
(defun ethio-get-consonant (ch)
- "Return the consonant part of CH's SERA spelling in ethiopic-sera."
+ "Return the consonant part of CH's SERA spelling in ethiopic-sera.
+SERA (System for Ethiopic Representation in ASCII) is the Latin
+representation of Ethiopic script."
(let ((sera (get-char-code-property ch 'ethiopic-sera)))
(cond
((null sera) nil)
@@ -813,7 +847,8 @@ The 2nd and 3rd arguments BEGIN and END specify the region."
;;;###autoload
(defun ethio-fidel-to-tex-buffer nil
- "Convert each fidel characters in the current buffer into a fidel-tex
command."
+ "Convert each FIDEL characters in the current buffer into a fidel-tex
command.
+FIDEL is the Amharic/Ethiopic alphabet."
(interactive)
(let ((buffer-read-only nil)
comp)
@@ -860,7 +895,8 @@ The 2nd and 3rd arguments BEGIN and END specify the region."
;;;###autoload
(defun ethio-tex-to-fidel-buffer ()
- "Convert fidel-tex commands in the current buffer into fidel chars."
+ "Convert fidel-tex commands in the current buffer into FIDEL chars.
+FIDEL is the Amharic/Ethiopic alphabet."
(interactive)
(let ((inhibit-read-only t)
;; (p) (ch)
@@ -888,7 +924,7 @@ The 2nd and 3rd arguments BEGIN and END specify the region."
;;;###autoload
(defun ethio-fidel-to-java-buffer nil
- "Convert Ethiopic characters into the Java escape sequences.
+ "Convert Ethiopic characters in the buffer into the Java escape sequences.
Each escape sequence is of the form \\uXXXX, where XXXX is the
character's codepoint (in hex) in Unicode.
@@ -907,7 +943,7 @@ Otherwise, [0-9A-F]."
;;;###autoload
(defun ethio-java-to-fidel-buffer nil
- "Convert the Java escape sequences into corresponding Ethiopic characters."
+ "Convert the Java escape sequences in the buffer into Ethiopic characters."
(let ((case-fold-search t)
(ucode))
(goto-char (point-min))
@@ -922,7 +958,17 @@ Otherwise, [0-9A-F]."
;;;###autoload
(defun ethio-find-file nil
- "Transliterate file content into Ethiopic depending on filename suffix."
+ "Transliterate file content into Ethiopic depending on filename suffix.
+If the file-name extension is \".sera\", convert from SERA to FIDEL.
+If the file-name extension is \".html\", convert regions enclosed
+by \"<sera>..</sera>\" from SERA to FIDEL.
+If the file-name extension is \".tex\", convert fidel-tex commands
+to FIDEL characters.
+If the file-name extension is \".java\", convert Java escape sequences
+to FIDEL characters.
+
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
(cond
((string-match "\\.sera$" (buffer-file-name))
@@ -956,7 +1002,17 @@ Otherwise, [0-9A-F]."
;;;###autoload
(defun ethio-write-file nil
- "Transliterate Ethiopic characters in ASCII depending on the file extension."
+ "Transliterate Ethiopic characters to ASCII depending on the file extension.
+If the file-name extension is \".sera\", convert from FIDEL to SERA.
+If the file-name extension is \".html\", convert FIDEL characters to
+SERA regions enclosed by \"<sera>..</sera>\".
+If the file-name extension is \".tex\", convert FIDEL characters
+to fidel-tex commands.
+If the file-name extension is \".java\", convert FIDEL characters to
+Java escape sequences.
+
+FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation
+in ASCII) is the Latin representation of Ethiopic script."
(cond
((string-match "\\.sera$" (buffer-file-name))
@@ -1062,7 +1118,7 @@ With ARG, insert that many delimiters."
;; This function is not used any more.
(defun ethio-gemination nil
- "Compose the character before the point with the Ethiopic gemination mark.
+ "Compose the character before point with the Ethiopic gemination mark.
If the character is already composed, decompose it and remove the gemination
mark."
(interactive "*")
@@ -1081,7 +1137,9 @@ mark."
;;;
(robin-define-package "ethiopic-sera"
- "SERA transliteration system for Ethiopic."
+ "SERA transliteration system for Ethiopic.
+SERA (System for Ethiopic Representation in ASCII) is the Latin
+representation of Ethiopic script."
("he" ?ሀ)
("hu" ?ሁ)
diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el
index 1faba424ba..fb1e272843 100644
--- a/lisp/language/ethiopic.el
+++ b/lisp/language/ethiopic.el
@@ -27,6 +27,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(define-ccl-program ccl-encode-ethio-font
diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el
index 27facaa858..447ca0c20c 100644
--- a/lisp/language/ind-util.el
+++ b/lisp/language/ind-util.el
@@ -27,11 +27,18 @@
;; Finally, this program provides the compatibility support with
;; old implementation of Devanagari script.
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
;;; Transliteration
-;; The followings provide the various transliteration schemes (such as
+;; The following provides the various transliteration schemes (such as
;; ITRANS, kyoto-harvard, and Aiba) of Indian scripts. They are also
;; used in quail/indian.el for typing Indian script in Emacs.
@@ -638,7 +645,7 @@
;;; IS 13194 utilities
-;; The followings provide conversion between IS 13194 (ISCII) and UCS.
+;; The following provides conversion between IS 13194 (ISCII) and UCS.
(dlet
;;Unicode vs IS13194 ;; only Devanagari is supported now.
diff --git a/lisp/language/indonesian.el b/lisp/language/indonesian.el
index 699f819254..5afcd27759 100644
--- a/lisp/language/indonesian.el
+++ b/lisp/language/indonesian.el
@@ -34,7 +34,8 @@
(input-method . "balinese")
(sample-text . "Balinese (ᬅᬓ᭄ᬱᬭᬩᬮᬶ) ᬒᬁᬲ᭄ᬯᬲ᭄ᬢ᭄ᬬᬲ᭄ᬢᬸ")
(documentation . "\
-Balinese language and its script are supported in this language
environment.")))
+Balinese language and its script are supported in this language environment."))
+ '("Indonesian"))
(set-language-info-alist
"Javanese" '((charset unicode)
@@ -43,7 +44,8 @@ Balinese language and its script are supported in this
language environment.")))
(input-method . "javanese")
(sample-text . "Javanese (ꦲꦏ꧀ꦱꦫꦗꦮ) ꦲꦭꦺꦴ")
(documentation . "\
-Javanese language and its script are supported in this language
environment.")))
+Javanese language and its script are supported in this language environment."))
+ '("Indonesian"))
(set-language-info-alist
"Sundanese" '((charset unicode)
@@ -52,7 +54,8 @@ Javanese language and its script are supported in this
language environment.")))
(input-method . "sundanese")
(sample-text . "Sundanese (ᮃᮊ᮪ᮞᮛᮞᮥᮔ᮪ᮓ) ᮞᮙ᮪ᮕᮥᮛᮞᮥᮔ᮪")
(documentation . "\
-Sundanese language and its script are supported in this language
environment.")))
+Sundanese language and its script are supported in this language
environment."))
+ '("Indonesian"))
(set-language-info-alist
"Batak" '((charset unicode)
@@ -62,7 +65,8 @@ Sundanese language and its script are supported in this
language environment."))
(sample-text . "Batak (ᯘᯮᯒᯗ᯲ᯅᯗᯂ᯲) ᯂᯬᯒᯘ᯲ / ᯔᯧᯐᯬᯀᯱᯐᯬᯀᯱ")
(documentation . "\
Languages that use the Batak script, such as Karo, Toba, Pakpak, Mandailing
-and Simalungun, are supported in this language environment.")))
+and Simalungun, are supported in this language environment."))
+ '("Indonesian"))
(set-language-info-alist
"Rejang" '((charset unicode)
@@ -71,7 +75,8 @@ and Simalungun, are supported in this language
environment.")))
(input-method . "rejang")
(sample-text . "Rejang (ꥆꤰ꥓ꤼꤽ ꤽꥍꤺꥏ) ꤸꥉꥐꤺꥉꥂꥎ")
(documentation . "\
-Rejang language and its script are supported in this language environment.")))
+Rejang language and its script are supported in this language environment."))
+ '("Indonesian"))
(set-language-info-alist
"Makasar" '((charset unicode)
@@ -80,7 +85,8 @@ Rejang language and its script are supported in this language
environment.")))
(input-method . "makasar")
(sample-text . "Makasar (𑻪𑻢𑻪𑻢) 𑻦𑻤𑻵𑻱")
(documentation . "\
-Makassarese language and its script Makasar are supported in this language
environment.")))
+Makassarese language and its script Makasar are supported in this language
environment."))
+ '("Indonesian"))
(set-language-info-alist
"Buginese" '((charset unicode)
@@ -89,7 +95,8 @@ Makassarese language and its script Makasar are supported in
this language envir
(input-method . "lontara")
(sample-text . "Buginese (ᨒᨚᨈᨑ) ᨖᨒᨚ")
(documentation . "\
-Buginese language and its script Lontara are supported in this language
environment.")))
+Buginese language and its script Lontara are supported in this language
environment."))
+ '("Indonesian"))
;; Balinese composition rules
(let ((consonant "[\x1B13-\x1B33\x1B45-\x1B4B]")
diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el
index 4a2e7838fc..230db3b100 100644
--- a/lisp/language/misc-lang.el
+++ b/lisp/language/misc-lang.el
@@ -228,7 +228,8 @@ thin (i.e. 1-dot width) space."
(sample-text . "Hanifi Rohingya (𐴌𐴟𐴇𐴥𐴝𐴚𐴒𐴙𐴝 𐴇𐴝𐴕𐴞𐴉𐴞 𐴓𐴠𐴑𐴤𐴝)
𐴀𐴝𐴏𐴓𐴝𐴀𐴡𐴤𐴛𐴝𐴓𐴝𐴙𐴑𐴟𐴔")
(documentation . "\
Rohingya language and its script Hanifi Rohingya are supported
-in this language environment.")))
+in this language environment."))
+ '("Misc"))
;; Hanifi Rohingya composition rules
(set-char-table-range
@@ -251,7 +252,8 @@ in this language environment.")))
(sample-text . "Kharoṣṭhī (𐨑𐨪𐨆𐨛𐨁) 𐨣𐨨𐨲𐨪𐨆 𐨐𐨪𐨅𐨨𐨁")
(documentation . "\
Language environment for Gāndhārī, Sanskrit, and other languages
-using the Kharoṣṭhī script.")))
+using the Kharoṣṭhī script."))
+ '("Indian"))
(let ((consonant "[\U00010A00\U00010A10-\U00010A35]")
(vowel "[\U00010A01-\U00010A06]")
@@ -281,7 +283,8 @@ using the Kharoṣṭhī script.")))
(sample-text . "Adlam (𞤀𞤣𞤤𞤢𞤥) 𞤅𞤢𞤤𞤢𞥄𞤥")
(documentation . "\
Fulani language and its script Adlam are supported
-in this language environment.")))
+in this language environment."))
+ '("Misc"))
;; Adlam composition rules
(set-char-table-range
@@ -303,7 +306,8 @@ in this language environment.")))
(sample-text . "Mende Kikakui (𞠀𞠁𞠂) 𞠛𞠉")
(documentation . "\
Mende language and its script Kikakui are supported
-in this language environment.")))
+in this language environment."))
+ '("Misc"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Gothic
@@ -317,7 +321,23 @@ in this language environment.")))
(sample-text . "Gothic (𐌲𐌿𐍄𐌹𐍃𐌺𐌰) 𐌷𐌰𐌹𐌻𐍃 / 𐌷𐌰𐌹𐌻𐌰")
(documentation . "\
Ancient Gothic language using the Gothic script is supported in this
-language environment.")))
+language environment."))
+ '("Misc"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Coptic
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(set-language-info-alist
+ "Coptic" '((charset unicode)
+ (coding-system utf-8)
+ (coding-priority utf-8)
+ (input-method . "coptic")
+ (sample-text . "Coptic (ⲘⲉⲧⲢⲉⲙ̀ⲛⲭⲏⲙⲓ) Ⲛⲟⲩϥⲣⲓ")
+ (documentation . "\
+Coptic language using the Coptic script is supported in this
+language environment."))
+ '("Misc"))
(provide 'misc-lang)
diff --git a/lisp/language/philippine.el b/lisp/language/philippine.el
index e52ad6912c..ce619bdaa1 100644
--- a/lisp/language/philippine.el
+++ b/lisp/language/philippine.el
@@ -35,7 +35,8 @@
(sample-text . "Tagalog (ᜊᜌ᜔ᜊᜌᜒᜈ᜔) ᜃᜓᜋᜓᜐ᜔ᜆ")
(documentation . "\
Tagalog language using the Baybayin script is supported in
-this language environment.")))
+this language environment."))
+ '("Philippine"))
(set-language-info-alist
"Hanunoo" '((charset unicode)
@@ -44,7 +45,8 @@ this language environment.")))
(input-method . "hanunoo")
(sample-text . "Hanunoo (ᜱᜨᜳᜨᜳᜢ) ᜫᜬᜧ᜴ ᜣᜭᜯᜥ᜴ ᜰᜲᜭᜥ᜴")
(documentation . "\
-Philippine Language Hanunoo is supported in this language environment.")))
+Philippine Language Hanunoo is supported in this language environment."))
+ '("Philippine"))
(set-language-info-alist
"Buhid" '((charset unicode)
@@ -52,7 +54,8 @@ Philippine Language Hanunoo is supported in this language
environment.")))
(coding-priority utf-8)
(input-method . "buhid")
(documentation . "\
-Philippine Language Buhid is supported in this language environment.")))
+Philippine Language Buhid is supported in this language environment."))
+ '("Philippine"))
(set-language-info-alist
"Tagbanwa" '((charset unicode)
@@ -61,7 +64,8 @@ Philippine Language Buhid is supported in this language
environment.")))
(input-method . "tagbanwa")
(sample-text . "Tagbanwa (ᝦᝪᝯ) ᝫᝩᝬᝥ ᝣᝮᝧᝯ")
(documentation . "\
-Philippine Languages Tagbanwa are supported in this language environment.")))
+Philippine Languages Tagbanwa are supported in this language environment."))
+ '("Philippine"))
;; Tagalog composition rules
(let ((akshara "[\x1700-\x1711\x171F]")
diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el
index e7cb289b65..0f09c48d6d 100644
--- a/lisp/language/tibet-util.el
+++ b/lisp/language/tibet-util.el
@@ -32,6 +32,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(defconst tibetan-obsolete-glyphs
diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el
index 0262798bb2..8121045789 100644
--- a/lisp/language/tibetan.el
+++ b/lisp/language/tibetan.el
@@ -34,6 +34,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
;;; Tibetan Character set.
diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el
index c9502fbb21..3f36cfbba5 100644
--- a/lisp/ldefs-boot.el
+++ b/lisp/ldefs-boot.el
@@ -3925,18 +3925,6 @@ See the documentation of `define-ccl-program' for the
detail of CCL program.
(register-definition-prefixes "ccl" '("ccl-"))
-;;; Generated autoloads from emacs-lisp/cconv.el
-
-(autoload 'cconv-closure-convert "cconv" "\
-Main entry point for closure conversion.
-FORM is a piece of Elisp code after macroexpansion.
-
-Returns a form where all lambdas don't have any free variables.
-
-(fn FORM)")
-(register-definition-prefixes "cconv" '("cconv-"))
-
-
;;; Generated autoloads from cdl.el
(register-definition-prefixes "cdl" '("cdl-"))
@@ -4702,14 +4690,13 @@ Search happens in `native-comp-eln-load-path'.
(autoload 'native-compile "comp" "\
Compile FUNCTION-OR-FILE into native code.
This is the synchronous entry-point for the Emacs Lisp native
-compiler.
-FUNCTION-OR-FILE is a function symbol, a form, or the filename of
-an Emacs Lisp source file.
-If OUTPUT is non-nil, use it as the filename for the compiled
-object.
-If FUNCTION-OR-FILE is a filename, return the filename of the
-compiled object. If FUNCTION-OR-FILE is a function symbol or a
-form, return the compiled function.
+compiler. FUNCTION-OR-FILE is a function symbol, a form, or the
+filename of an Emacs Lisp source file. If OUTPUT is non-nil, use
+it as the filename for the compiled object. If FUNCTION-OR-FILE
+is a filename, if the compilation was successful return the
+filename of the compiled object. If FUNCTION-OR-FILE is a
+function symbol or a form, if the compilation was successful
+return the compiled function.
(fn FUNCTION-OR-FILE &optional OUTPUT)")
(autoload 'batch-native-compile "comp" "\
@@ -8981,6 +8968,55 @@ Turn on EDT Emulation." t)
(register-definition-prefixes "edt-vt100" '("edt-set-term-width-"))
+;;; Generated autoloads from progmodes/eglot.el
+
+(push (purecopy '(eglot 1 9)) package--builtin-versions)
+(autoload 'eglot "eglot" "\
+Start LSP server in support of PROJECT's buffers under MANAGED-MAJOR-MODE.
+
+This starts a Language Server Protocol (LSP) server suitable for the
+buffers of PROJECT whose `major-mode' is MANAGED-MAJOR-MODE.
+CLASS is the class of the LSP server to start and CONTACT specifies
+how to connect to the server.
+
+Interactively, the command attempts to guess MANAGED-MAJOR-MODE
+from the current buffer's `major-mode', CLASS and CONTACT from
+`eglot-server-programs' looked up by the major mode, and PROJECT from
+`project-find-functions'. The search for active projects in this
+context binds `eglot-lsp-context' (which see).
+
+If it can't guess, it prompts the user for the mode and the server.
+With a single \\[universal-argument] prefix arg, it always prompts for COMMAND.
+With two \\[universal-argument], it also always prompts for MANAGED-MAJOR-MODE.
+
+The LSP server of CLASS is started (or contacted) via CONTACT.
+If this operation is successful, current *and future* file
+buffers of MANAGED-MAJOR-MODE inside PROJECT become \"managed\"
+by the LSP server, meaning the information about their contents is
+exchanged periodically with the server to provide enhanced
+code-analysis via `xref-find-definitions', `flymake-mode',
+`eldoc-mode', and `completion-at-point', among others.
+
+PROJECT is a project object as returned by `project-current'.
+
+CLASS is a subclass of `eglot-lsp-server'.
+
+CONTACT specifies how to contact the server. It is a
+keyword-value plist used to initialize CLASS or a plain list as
+described in `eglot-server-programs', which see.
+
+LANGUAGE-ID is the language ID string to send to the server for
+MANAGED-MAJOR-MODE, which matters to a minority of servers.
+
+INTERACTIVE is t if called interactively.
+
+(fn MANAGED-MAJOR-MODE PROJECT CLASS CONTACT LANGUAGE-ID &optional
INTERACTIVE)" t)
+(autoload 'eglot-ensure "eglot" "\
+Start Eglot session for current buffer if there isn't one.")
+(put 'eglot-workspace-configuration 'safe-local-variable 'listp)
+(register-definition-prefixes "eglot" '("eglot-"))
+
+
;;; Generated autoloads from ehelp.el
(autoload 'with-electric-help "ehelp" "\
@@ -9974,7 +10010,7 @@ If ERC is already connected to HOST:PORT, simply /join
CHANNEL.
Otherwise, connect to HOST:PORT as USER and /join CHANNEL.
(fn HOST PORT CHANNEL USER PASSWORD)")
-(register-definition-prefixes "erc" '("define-erc-module" "erc-"))
+(register-definition-prefixes "erc" '("erc-"))
;;; Generated autoloads from erc/erc-autoaway.el
@@ -9997,6 +10033,11 @@ Otherwise, connect to HOST:PORT as USER and /join
CHANNEL.
(register-definition-prefixes "erc-capab" '("erc-capab-identify-"))
+;;; Generated autoloads from erc/erc-common.el
+
+(register-definition-prefixes "erc-common" '("define-erc-module" "erc-"))
+
+
;;; Generated autoloads from erc/erc-compat.el
(register-definition-prefixes "erc-compat" '("erc-"))
@@ -10895,6 +10936,23 @@ Edit the hotlist of directory servers in a specialized
buffer." t)
(register-definition-prefixes "eudcb-bbdb" '("eudc-bbdb-"))
+;;; Generated autoloads from net/eudcb-ecomplete.el
+
+(autoload 'eudc-ecomplete-query-internal "eudcb-ecomplete" "\
+Query `ecomplete' with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE). Since `ecomplete'
+does not provide attributes in the usual sense, the
+back-end-specific attribute names in
+`eudc-ecomplete-attributes-translation-alist' are used as the
+KEY (that is, the \"type\" of match) when looking for matches in
+`ecomplete-database'.
+
+RETURN-ATTRS is ignored.
+
+(fn QUERY &optional RETURN-ATTRS)")
+(register-definition-prefixes "eudcb-ecomplete"
'("eudc-ecomplete-attributes-translation-alist"))
+
+
;;; Generated autoloads from net/eudcb-ldap.el
(register-definition-prefixes "eudcb-ldap" '("eudc-"))
@@ -10910,6 +10968,26 @@ Edit the hotlist of directory servers in a specialized
buffer." t)
(register-definition-prefixes "eudcb-macos-contacts" '("eudc-macos-contacts-"))
+;;; Generated autoloads from net/eudcb-mailabbrev.el
+
+(autoload 'eudc-mailabbrev-query-internal "eudcb-mailabbrev" "\
+Query `mailabbrev' with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE). Since `mailabbrev'
+does not provide attributes in the usual sense, only the email,
+name, and firstname attributes in the QUERY are considered, and
+their values are matched against the alias names in the mailrc
+file. When a mailrc alias is a distribution list, that is it
+expands to more that one email address, the individual recipient
+specifications are formatted using `eudc-rfc5322-make-address',
+and returned as a comma-separated list in the email address
+attribute.
+
+RETURN-ATTRS is a list of attributes to return, defaulting to
+`eudc-default-return-attributes'.
+
+(fn QUERY &optional RETURN-ATTRS)")
+
+
;;; Generated autoloads from emacs-lisp/ewoc.el
(autoload 'ewoc-create "ewoc" "\
@@ -11244,7 +11322,7 @@ See `text-scale-increase' for more details.
(define-key ctl-x-map [(control ?0)] 'text-scale-adjust)
(autoload 'text-scale-adjust "face-remap" "\
Adjust the font size in the current buffer by INC steps.
-INC may be passed as a numeric prefix argument.
+Interactively, INC is the prefix numeric argument, and defaults to 1.
The actual adjustment made depends on the final component of the
keybinding used to invoke the command, with all modifiers removed:
@@ -11254,13 +11332,14 @@ keybinding used to invoke the command, with all
modifiers removed:
\\`0' Reset the font size to the global default
After adjusting, continue to read input events and further adjust
-the font size as long as the input event read
-(with all modifiers removed) is one of the above characters.
+the font size as long as the input event (with all modifiers removed)
+is one of the above characters.
-Each step scales the height of the default face by the variable
-`text-scale-mode-step' (a negative number of steps decreases the
-height by the same amount). As a special case, an argument of 0
-will remove any scaling currently active.
+Each step scales the height of the default face by the factor that
+is the value of `text-scale-mode-step' (a negative number of steps
+decreases the height by that factor). As a special case, an argument
+of 0 will remove any scaling currently active, thus resetting the
+font size to the original value.
This command is a special-purpose wrapper around the
`text-scale-increase' command which makes repetition convenient
@@ -11286,19 +11365,22 @@ Adjust the height of the default face by the scale in
the pinch event EVENT.
(define-key ctl-x-map [(control meta ?-)] 'global-text-scale-adjust)
(define-key ctl-x-map [(control meta ?0)] 'global-text-scale-adjust)
(autoload 'global-text-scale-adjust "face-remap" "\
-Globally adjust the font size by INCREMENT.
+Change (a.k.a. \"adjust\") the font size of all faces by INCREMENT.
-Interactively, INCREMENT may be passed as a numeric prefix argument.
+Interactively, INCREMENT is the prefix numeric argument, and defaults
+to 1. Positive values of INCREMENT increase the font size, negative
+values decrease it.
-The adjustment made depends on the final component of the key binding
-used to invoke the command, with all modifiers removed:
+When you invoke this command, it performs the initial change of the
+font size, and after that allows further changes by typing one of the
+following keys immediately after invoking the command:
\\`+', \\`=' Globally increase the height of the default face
\\`-' Globally decrease the height of the default face
\\`0' Globally reset the height of the default face
-After adjusting, further adjust the font size as long as the key,
-with all modifiers removed, is one of the above characters.
+(The change of the font size produced by these keys depends on the
+final component of the key sequence, with all modifiers removed.)
Buffer-local face adjustments have higher priority than global
face adjustments.
@@ -11719,6 +11801,17 @@ variables are set in the server's process buffer
according to the
VARIABLES list of the connection profile. The list is processed
in order.
+(fn PROFILE VARIABLES)")
+(autoload 'connection-local-update-profile-variables "files-x" "\
+Update the variable settings for PROFILE in-place.
+VARIABLES is a list that declares connection-local variables for
+the connection profile. An element in VARIABLES is an alist
+whose elements are of the form (VAR . VALUE).
+
+Unlike `connection-local-set-profile-variables' (which see), this
+function preserves the values of any existing variable
+definitions that aren't listed in VARIABLES.
+
(fn PROFILE VARIABLES)")
(autoload 'hack-connection-local-variables-apply "files-x" "\
Apply connection-local variables identified by CRITERIA.
@@ -11731,11 +11824,38 @@ Apply connection-local variables according to
`default-directory'.
Execute BODY, and unwind connection-local variables.
(fn &rest BODY)" nil t)
+(autoload 'with-connection-local-application-variables "files-x" "\
+Apply connection-local variables for APPLICATION in `default-directory'.
+Execute BODY, and unwind connection-local variables.
+
+(fn APPLICATION &rest BODY)" nil t)
+(function-put 'with-connection-local-application-variables
'lisp-indent-function 1)
(autoload 'with-connection-local-variables-1 "files-x" "\
Apply connection-local variables according to `default-directory'.
Call BODY-FUN with no args, and then unwind connection-local variables.
(fn BODY-FUN)")
+(autoload 'setq-connection-local "files-x" "\
+Set each VARIABLE connection-locally to VALUE.
+
+When `connection-local-profile-name-for-setq' is set, assign each
+variable's value on that connection profile, and set that profile
+for `connection-local-criteria'. You can use this in combination
+with `with-connection-local-variables', as in
+
+ (with-connection-local-variables
+ (setq-connection-local VARIABLE VALUE))
+
+If there's no connection-local profile to use, just set the
+variables normally, as with `setq'.
+
+The variables are literal symbols and should not be quoted. The
+second VALUE is not computed until after the first VARIABLE is
+set, and so on; each VALUE can use the new value of variables set
+earlier in the `setq-connection-local'. The return value of the
+`setq-connection-local' form is the value of the last VALUE.
+
+(fn [VARIABLE VALUE]...)" nil t)
(autoload 'path-separator "files-x" "\
The connection-local value of `path-separator'.")
(autoload 'null-device "files-x" "\
@@ -14367,7 +14487,12 @@ Run gdb passing it COMMAND-LINE as arguments.
If COMMAND-LINE names a program FILE to debug, gdb will run in
a buffer named *gud-FILE*, and the directory containing FILE
becomes the initial working directory and source-file directory
-for your debugger.
+for your debugger. If you don't want `default-directory' to
+change to the directory of FILE, specify FILE without leading
+directories, in which case FILE should reside either in the
+directory of the buffer from which this command is invoked, or
+it can be found by searching PATH.
+
If COMMAND-LINE requests that gdb attaches to a process PID, gdb
will run in *gud-PID*, otherwise it will run in *gud*; in these
cases the initial working directory is the `default-directory' of
@@ -15397,7 +15522,7 @@ it is disabled.
;;; Generated autoloads from progmodes/hideshow.el
-(defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil
nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1))
(java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil) (mhtml-mode
"{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil))) "\
+(defvar hs-special-modes-alist (mapcar #'purecopy '((c-mode "{" "}" "/[*/]"
nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)"
1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil)
(mhtml-mode "{\\|<[^/>]*?" "}\\|</[^/>]*[^/]>" "<!--" mhtml-forward nil))) "\
Alist for initializing the hideshow variables for different modes.
Each element has the form
(MODE START END COMMENT-START FORWARD-SEXP-FUNC ADJUST-BEG-FUNC
@@ -17379,7 +17504,7 @@ Convert old Emacs Devanagari characters to UCS.
;;; Generated autoloads from leim/quail/indian.el
-(register-definition-prefixes "quail/indian" '("indian-mlm-mozhi-u"
"inscript-" "quail-" "tamil-"))
+(register-definition-prefixes "quail/indian" '("indian-mlm-mozhi-u"
"inscript-" "quail-" "tamil"))
;;; Generated autoloads from progmodes/inf-lisp.el
@@ -18726,6 +18851,7 @@ This scans for ;;;###autoload forms and related things.
The first element on the command line should be the (main)
loaddefs.el output file, and the rest are the directories to
use.")
+ (load "theme-loaddefs.el" t)
(register-definition-prefixes "loaddefs-gen" '("autoload-"
"generated-autoload-" "loaddefs-generate--" "no-update-autoloads"))
@@ -18847,6 +18973,8 @@ done. Otherwise, this function will use the current
buffer.
Major mode for browsing CVS log output.
(fn)" t)
+(autoload 'log-view-get-marked "log-view" "\
+Return the list of tags for the marked log entries.")
(register-definition-prefixes "log-view" '("log-view-"))
@@ -19530,7 +19658,7 @@ Populate MENU with commands that open a man page at
point.
;;; Generated autoloads from emacs-lisp/map.el
-(push (purecopy '(map 3 2 1)) package--builtin-versions)
+(push (purecopy '(map 3 3 1)) package--builtin-versions)
(register-definition-prefixes "map" '("map-"))
@@ -21135,6 +21263,9 @@ a greeting from the server.
:nowait, if non-nil, says the connection should be made
asynchronously, if possible.
+:noquery - when exiting Emacs and the network process is running,
+don't query the user if it's non-nil.
+
:shell-command is a `format-spec' string that can be used if
:type is `shell'. It has two specs, %s for host and %p for port
number. Example: \"ssh gateway nc %s %p\".
@@ -22982,6 +23113,81 @@ Location of the file used to speed up activation of
packages at startup." :type
(register-definition-prefixes "package" '("bad-signature" "define-package"
"describe-package-1" "package-"))
+;;; Generated autoloads from emacs-lisp/package-vc.el
+
+(defvar package-vc-selected-packages 'nil "\
+List of packages that must be installed.
+Each member of the list is of the form (NAME . SPEC), where NAME
+is a symbol designating the package and SPEC is one of:
+
+- nil, if any package version can be installed;
+- a version string, if that specific revision is to be installed;
+- a property list of the form described in
+ `package-vc-archive-spec-alist', giving a package
+ specification.
+
+This user option differs from `package-selected-packages' in that
+it is meant to be specified manually. You can also use the
+function `package-vc-selected-packages' to apply the changes.")
+(custom-autoload 'package-vc-selected-packages "package-vc" nil)
+(autoload 'package-vc-install "package-vc" "\
+Fetch a package NAME-OR-URL and set it up for using with Emacs.
+If NAME-OR-URL is a URL, download the package from the repository
+at that URL; the function will try to guess the name of the package
+from the URL. Otherwise NAME-OR-URL should be a symbol whose name
+is the package name, and the URL for the package will be taken from
+the package's metadata.
+By default, this function installs the last version of the package
+available from its repository, but if REV is given and non-nil, it
+specifies the revision to install. If REV has the special value
+`:last-release' (interactively, the prefix argument), that stands
+for the last released version of the package.
+When calling from Lisp, optional argument NAME overrides the package
+name as deduced from NAME-OR-URL.
+Optional argument BACKEND specifies the VC backend to use for cloning
+the package's repository; this is only possible if NAME-OR-URL is a URL,
+a string. If BACKEND is omitted or nil, the function
+uses `package-vc--guess-backend' to guess the backend.
+
+(fn NAME-OR-URL &optional NAME REV BACKEND)" t)
+(autoload 'package-vc-checkout "package-vc" "\
+Clone the sources for PKG-DESC into DIRECTORY and visit that directory.
+Unlike `package-vc-install', this does not yet set up the package
+for use with Emacs; use `package-vc-link-directory' for setting
+the package up after this function finishes.
+Optional argument REV means to clone a specific version of the
+package; it defaults to the last version available from the
+package's repository. If REV has the special value
+`:last-release' (interactively, the prefix argument), that stands
+for the last released version of the package.
+
+(fn PKG-DESC DIRECTORY &optional REV)" t)
+(autoload 'package-vc-install-from-checkout "package-vc" "\
+Set up the package NAME in DIR by linking it into the ELPA directory.
+Interactively, prompt the user for DIR, which should be a directory
+under version control, typically one created by `package-vc-checkout'.
+If invoked interactively with a prefix argument, prompt the user
+for the NAME of the package to set up. Otherwise infer the package
+name from the base name of DIR.
+
+(fn DIR NAME)" t)
+(autoload 'package-vc-refresh "package-vc" "\
+Refresh the installation for package given by PKG-DESC.
+Interactively, prompt for the name of the package to refresh.
+
+(fn PKG-DESC)" t)
+(autoload 'package-vc-prepare-patch "package-vc" "\
+Send patch for REVISIONS to maintainer of the package PKG using SUBJECT.
+SUBJECT and REVISIONS are passed on to `vc-prepare-patch', which see.
+PKG must be a package description.
+Interactively, prompt for PKG, SUBJECT, and REVISIONS. However,
+if the current buffer has marked commit log entries, REVISIONS
+are the tags of the marked entries, see `log-view-get-marked'.
+
+(fn PKG SUBJECT REVISIONS)" t)
+(register-definition-prefixes "package-vc" '("package-vc-"))
+
+
;;; Generated autoloads from emacs-lisp/package-x.el
(autoload 'package-upload-file "package-x" "\
@@ -24534,7 +24740,7 @@ Open profile FILENAME.
;;; Generated autoloads from progmodes/project.el
-(push (purecopy '(project 0 8 1)) package--builtin-versions)
+(push (purecopy '(project 0 8 3)) package--builtin-versions)
(autoload 'project-current "project" "\
Return the project instance in DIRECTORY, defaulting to `default-directory'.
@@ -25926,6 +26132,9 @@ The mode's hook is called both when the mode is enabled
and when
it is disabled.
(fn &optional ARG)" t)
+(autoload 'repeat-exit "repeat" "\
+Exit the repeating sequence.
+This function can be used to force exit of repetition while it's active." t)
(register-definition-prefixes "repeat" '("describe-repeat-maps" "repeat-"))
@@ -26474,7 +26683,7 @@ Emacs will list the message in the summary.
(fn REGEXP)" t)
(autoload 'rmail-summary-by-topic "rmailsum" "\
Display a summary of all messages with the given SUBJECT.
-Normally checks just the Subject field of headers; but with prefix
+Normally checks just the Subject field of headers; but when prefix
argument WHOLE-MESSAGE is non-nil, looks in the whole message.
SUBJECT is a regular expression.
@@ -26659,6 +26868,8 @@ Return ROT13 encryption of STRING.
(fn STRING)")
(autoload 'rot13-region "rot13" "\
ROT13 encrypt the region between START and END in current buffer.
+If invoked interactively and the buffer is read-only, a message
+will be printed instead.
(fn START END)" t)
(autoload 'rot13-other-window "rot13" "\
@@ -29436,6 +29647,8 @@ PROMPT will be inserted at the start of the buffer, but
won't be
included in the resulting string. If PROMPT is nil, no help text
will be inserted.
+Also see `read-string-from-buffer'.
+
(fn PROMPT STRING SUCCESS-CALLBACK &key ABORT-CALLBACK)")
(autoload 'read-string-from-buffer "string-edit" "\
Switch to a new buffer to edit STRING in a recursive edit.
@@ -29445,6 +29658,8 @@ PROMPT will be inserted at the start of the buffer, but
won't be
included in the resulting string. If nil, no prompt will be
inserted in the buffer.
+Also see `string-edit'.
+
(fn PROMPT STRING)")
(register-definition-prefixes "string-edit" '("string-edit-"))
@@ -32000,14 +32215,14 @@ Add archive file name handler to
`file-name-handler-alist'." (when (and tramp-ar
(register-definition-prefixes "tramp-compat" '("tramp-"))
-;;; Generated autoloads from net/tramp-crypt.el
+;;; Generated autoloads from net/tramp-container.el
-(register-definition-prefixes "tramp-crypt" '("tramp-crypt-"))
+(register-definition-prefixes "tramp-container" '("tramp-"))
-;;; Generated autoloads from net/tramp-docker.el
+;;; Generated autoloads from net/tramp-crypt.el
-(register-definition-prefixes "tramp-docker" '("tramp-docker-"))
+(register-definition-prefixes "tramp-crypt" '("tramp-crypt-"))
;;; Generated autoloads from net/tramp-ftp.el
@@ -32740,6 +32955,10 @@ if it had been inserted from a file named URL.
(fn URL &optional VISIT BEG END REPLACE)")
+(autoload 'url-insert-file-contents-literally "url-handlers" "\
+Insert the data retrieved from URL literally in the current buffer.
+
+(fn URL)")
(register-definition-prefixes "url-handlers" '("url-"))
@@ -32992,7 +33211,7 @@ Like `message', but do nothing if `url-show-status' is
nil.
(fn X Y)")
-(defalias 'url-basepath 'url-file-directory)
+(defalias 'url-basepath #'url-file-directory)
(autoload 'url-file-directory "url-util" "\
Return the directory part of FILE, for a URL.
@@ -33440,11 +33659,13 @@ Show the change log for BRANCH root in a window.
(autoload 'vc-log-incoming "vc" "\
Show log of changes that will be received with pull from REMOTE-LOCATION.
When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
+In some version control systems REMOTE-LOCATION can be a remote branch name.
(fn &optional REMOTE-LOCATION)" t)
(autoload 'vc-log-outgoing "vc" "\
Show log of changes that will be sent with a push operation to REMOTE-LOCATION.
When called interactively with a prefix argument, prompt for REMOTE-LOCATION.
+In some version control systems REMOTE-LOCATION can be a remote branch name.
(fn &optional REMOTE-LOCATION)" t)
(autoload 'vc-log-search "vc" "\
@@ -33571,6 +33792,18 @@ log entries should be gathered.
Request editing the next VC shell command before execution.
This is a prefix command. It affects only a VC command executed
immediately after this one." t)
+(autoload 'vc-prepare-patch "vc" "\
+Compose an Email sending patches for REVISIONS to ADDRESSEE.
+If `vc-prepare-patches-separately' is nil, SUBJECT will be used
+as the default subject for the message (and it will be prompted
+for when called interactively). Otherwise a separate message
+will be composed for each revision, with SUBJECT derived from the
+invidividual commits.
+
+When invoked interactively in a Log View buffer with marked
+revisions, those revisions will be used.
+
+(fn ADDRESSEE SUBJECT REVISIONS)" t)
(register-definition-prefixes "vc" '("vc-" "with-vc-properties"))
@@ -34565,10 +34798,6 @@ Convert Vietnamese characters of the current buffer to
`VIQR' mnemonics." t)
;;; Generated autoloads from view.el
-(defvar view-remove-frame-by-deleting t "\
-Determine how View mode removes a frame no longer needed.
-If nil, make an icon of the frame. If non-nil, delete the frame.")
-(custom-autoload 'view-remove-frame-by-deleting "view" t)
(defvar-local view-mode nil "\
Non-nil if View mode is enabled.
Don't change this variable directly, you must change it by one of the
@@ -36122,7 +36351,13 @@ Extract file name from an yenc header.")
;;; Generated autoloads from play/zone.el
(autoload 'zone "zone" "\
-Zone out, completely." t)
+Zone out, completely.
+With a prefix argument the user is prompted for a program to run.
+When called from Lisp the optional argument PGM can be used to
+run a specific program. The program must be a member of
+`zone-programs'.
+
+(fn &optional PGM)" t)
(register-definition-prefixes "zone" '("zone-"))
;;; End of scraped data
diff --git a/lisp/leim/quail/ethiopic.el b/lisp/leim/quail/ethiopic.el
index c8753effe0..df4bf596cb 100644
--- a/lisp/leim/quail/ethiopic.el
+++ b/lisp/leim/quail/ethiopic.el
@@ -26,6 +26,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(require 'quail)
diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el
index 048e16e8d8..8fe81a2217 100644
--- a/lisp/leim/quail/indian.el
+++ b/lisp/leim/quail/indian.el
@@ -30,6 +30,8 @@
;;; Code:
+(require 'pcase)
+(require 'seq)
(require 'quail)
(require 'ind-util)
@@ -369,9 +371,9 @@ Full key sequences are listed below:")
;;; Tamil phonetic input method
;;;
-;; Define the input method straightaway.
+;; Define the input method straight away.
(quail-define-package "tamil-phonetic" "Tamil" "ழ" t
- "Customisable Tamil phonetic input method.
+ "Customizable Tamil phonetic input method.
To change the translation rules of the input method, customize
`tamil-translation-rules'.
@@ -699,6 +701,165 @@ is."
"tamil-inscript-digits" "Tamil" "TmlISD"
"Tamil keyboard Inscript with Tamil digits support.")
+;; Tamil99 input method
+;;
+;; Tamil99 is a keyboard layout and input method that is specifically
+;; designed for the Tamil language. Vowels and vowel modifiers are
+;; input with your left hand, and consonants are input with your right
+;; hand. See https://en.wikipedia.org/wiki/Tamil_99
+;;
+;; தமிழ்99 உள்ளீட்டு முறை
+;;
+;; தமிழ்99 தமிழுக்கென்றே உருவாக்கப்பட்ட விசைப்பலகை அமைப்பும் உள்ளீட்டு முறையும்
+;; ஆகும். உயிர்களை இடக்கையுடனும் மெய்களை வலக்கையுடனும் தட்டச்சிடும்படி
+;; அமைக்கப்பட்டது.
https://ta.wikipedia.org/wiki/%E0%AE%A4%E0%AE%AE%E0%AE%BF%E0%AE%B4%E0%AF%8D_99
+;; காண்க.
+
+(quail-define-package
+ "tamil99" "Tamil" "தமிழ்99"
+ t "Tamil99 input method"
+ nil t t t t nil nil nil nil nil t)
+
+(defconst tamil99-vowels
+ '(("q" "ஆ")
+ ("w" "ஈ")
+ ("e" "ஊ")
+ ("r" "ஐ")
+ ("t" "ஏ")
+ ("a" "அ")
+ ("s" "இ")
+ ("d" "உ")
+ ("g" "எ")
+ ("z" "ஔ")
+ ("x" "ஓ")
+ ("c" "ஒ"))
+ "Mapping for vowels.")
+
+(defconst tamil99-vowel-modifiers
+ '(("q" "ா")
+ ("w" "ீ")
+ ("e" "ூ")
+ ("r" "ை")
+ ("t" "ே")
+ ("a" "")
+ ("s" "ி")
+ ("d" "ு")
+ ("g" "ெ")
+ ("z" "ௌ")
+ ("x" "ோ")
+ ("c" "ொ")
+ ("f" "்"))
+ "Mapping for vowel modifiers.")
+
+(defconst tamil99-hard-consonants
+ '(("h" "க")
+ ("[" "ச")
+ ("o" "ட")
+ ("l" "த")
+ ("j" "ப")
+ ("u" "ற"))
+ "Mapping for hard consonants (வல்லினம்).")
+
+(defconst tamil99-soft-consonants
+ '(("b" "ங")
+ ("]" "ஞ")
+ ("p" "ண")
+ (";" "ந")
+ ("k" "ம")
+ ("i" "ன"))
+ "Mapping for soft consonants (மெல்லினம்).")
+
+(defconst tamil99-medium-consonants
+ '(("'" "ய")
+ ("m" "ர")
+ ("n" "ல")
+ ("v" "வ")
+ ("/" "ழ")
+ ("y" "ள"))
+ "Mapping for medium consonants (இடையினம்).")
+
+(defconst tamil99-grantham-consonants
+ '(("Q" "ஸ")
+ ("W" "ஷ")
+ ("E" "ஜ")
+ ("R" "ஹ"))
+ "Mapping for grantham consonants (கிரந்தம்).")
+
+(defconst tamil99-consonants
+ (append tamil99-hard-consonants
+ tamil99-soft-consonants
+ tamil99-medium-consonants
+ tamil99-grantham-consonants)
+ "Mapping for all consonants.")
+
+(defconst tamil99-other
+ `(("T" ,(vector "க்ஷ"))
+ ("Y" ,(vector "ஶஂரீ"))
+ ("O" "[")
+ ("P" "]")
+ ("A" "௹")
+ ("S" "௺")
+ ("D" "௸")
+ ("F" "ஃ")
+ ("K" "\"")
+ ("L" ":")
+ (":" ";")
+ ("\"" "'")
+ ("Z" "௳")
+ ("X" "௴")
+ ("C" "௵")
+ ("V" "௶")
+ ("B" "௷")
+ ("M" "/"))
+ "Mapping for miscellaneous characters.")
+
+;; உயிர்
+;; vowel
+(mapc (pcase-lambda (`(,vowel-key ,vowel))
+ (quail-defrule vowel-key vowel))
+ tamil99-vowels)
+
+(mapc (pcase-lambda (`(,consonant-key ,consonant))
+ ;; அகர உயிர்மெய்
+ ;; consonant symbol (consonant combined with the first vowel அ)
+ (quail-defrule consonant-key consonant)
+ ;; மெய்யொற்று பின் அகர உயிர்மெய்
+ ;; pulli on double consonant
+ (quail-defrule (concat consonant-key consonant-key)
+ (vector (concat consonant "்" consonant)))
+ (mapc (pcase-lambda (`(,vowel-key ,vowel-modifier))
+ ;; உயிர்மெய்
+ ;; vowelised consonant
+ (quail-defrule (concat consonant-key vowel-key)
+ (vector (concat consonant vowel-modifier)))
+ ;; மெய்யொற்று பின் பிற உயிர்மெய்
+ ;; vowelised consonant after double consonant
+ (quail-defrule (concat consonant-key consonant-key vowel-key)
+ (vector (concat consonant "்" consonant
vowel-modifier))))
+ tamil99-vowel-modifiers))
+ tamil99-consonants)
+
+(seq-mapn (pcase-lambda (`(,soft-consonant-key ,soft-consonant)
+ `(,hard-consonant-key ,hard-consonant))
+ ;; மெல்லினம் பின் வல்லினம்
+ ;; hard consonant after soft consonant
+ (quail-defrule (concat soft-consonant-key hard-consonant-key)
+ (vector (concat soft-consonant "்" hard-consonant)))
+ (mapc (pcase-lambda (`(,vowel-key ,vowel-modifier))
+ ;; மெல்லின ஒற்றொட்டிய வல்லினம் பின் உயிர்மெய்
+ ;; vowelised consonant after soft-hard consonant pair
+ (quail-defrule (concat soft-consonant-key
hard-consonant-key vowel-key)
+ (vector (concat soft-consonant "்"
hard-consonant vowel-modifier))))
+ tamil99-vowel-modifiers))
+ tamil99-soft-consonants
+ tamil99-hard-consonants)
+
+;; பிற வரியுருக்கள்
+;; other characters
+(mapc (pcase-lambda (`(,key ,translation))
+ (quail-defrule key translation))
+ tamil99-other)
+
;; Probhat Input Method
(quail-define-package
"bengali-probhat" "Bengali" "BngPB" t
diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el
index df080fc0e8..fb8b9e6166 100644
--- a/lisp/leim/quail/japanese.el
+++ b/lisp/leim/quail/japanese.el
@@ -359,7 +359,7 @@ input method.
The input method `japanese-zenkaku' is used to enter full width
JISX0208 characters corresponding to typed ASCII characters.
-List of the all key sequences for Roman-Kana transliteration is shown
+List of all the key sequences for Roman-Kana transliteration is shown
at the tail.
:: Kana-Kanji conversion ::
diff --git a/lisp/leim/quail/misc-lang.el b/lisp/leim/quail/misc-lang.el
index dad5cfc3e3..e9e11ac679 100644
--- a/lisp/leim/quail/misc-lang.el
+++ b/lisp/leim/quail/misc-lang.el
@@ -1526,7 +1526,7 @@
(quail-define-package
"gothic" "Gothic" "𐌰" nil
- "Input methid for the ancient Gothic script."
+ "Input method for the ancient Gothic script."
nil t t t t nil nil nil nil nil t)
(quail-define-rules
@@ -1558,5 +1558,122 @@
("n" ?𐌽)
("m" ?𐌼))
+(quail-define-package
+ "coptic" "Coptic" "Ⲁ" nil "Coptic input method.
+
+ `\\=`' is used to switch levels instead of Alt-Gr."
+ nil t t t t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?𐋡)
+ ("`1" ?1)
+ ("`!" ?𐋠)
+ ("2" ?𐋢)
+ ("`2" ?2)
+ ("3" ?𐋣)
+ ("`3" ?3)
+ ("4" ?𐋤)
+ ("`4" ?4)
+ ("5" ?𐋥)
+ ("`5" ?5)
+ ("6" ?𐋦)
+ ("`6" ?6)
+ ("7" ?𐋧)
+ ("`7" ?7)
+ ("8" ?𐋨)
+ ("`8" ?8)
+ ("9" ?𐋩)
+ ("`9" ?9)
+ ("10" ?𐋪)
+ ("20" ?𐋫)
+ ("30" ?𐋬)
+ ("40" ?𐋭)
+ ("50" ?𐋮)
+ ("60" ?𐋯)
+ ("70" ?𐋰)
+ ("80" ?𐋱)
+ ("90" ?𐋲)
+ ("100" ?𐋳)
+ ("200" ?𐋴)
+ ("300" ?𐋵)
+ ("400" ?𐋶)
+ ("500" ?𐋷)
+ ("600" ?𐋸)
+ ("700" ?𐋹)
+ ("800" ?𐋺)
+ ("900" ?𐋻)
+ ("1/2" ?⳽)
+
+ ("q" ?ⲑ)
+ ("Q" ?Ⲑ)
+ ("w" ?ⲱ)
+ ("W" ?Ⲱ)
+ ("e" ?ⲉ)
+ ("E" ?Ⲉ)
+ ("r" ?ⲣ)
+ ("R" ?Ⲣ)
+ ("t" ?ⲧ)
+ ("T" ?Ⲧ)
+ ("ti" ?ϯ)
+ ("Ti" ?Ϯ)
+ ("y" ?ⲏ)
+ ("Y" ?Ⲏ)
+ ("u" ?ⲩ)
+ ("U" ?Ⲩ)
+ ("i" ?ⲓ)
+ ("I" ?Ⲓ)
+ ("o" ?ⲟ)
+ ("O" ?Ⲟ)
+ ("p" ?ⲡ)
+ ("P" ?Ⲡ)
+ ("ps" ?ⲯ)
+ ("Ps" ?Ⲯ)
+ ("a" ?ⲁ)
+ ("A" ?Ⲁ)
+ ("s" ?ⲥ)
+ ("S" ?Ⲥ)
+ ("`s" ?ⲋ)
+ ("`S" ?Ⲋ)
+ ("sh" ?ϣ)
+ ("Sh" ?Ϣ)
+ ("d" ?ⲇ)
+ ("D" ?Ⲇ)
+ ("f" ?ⲫ)
+ ("F" ?Ⲫ)
+ ("g" ?ⲅ)
+ ("G" ?Ⲅ)
+ ("h" ?ϩ)
+ ("H" ?Ϩ)
+ ("j" ?ϫ)
+ ("J" ?Ϫ)
+ ("k" ?ⲕ)
+ ("K" ?Ⲕ)
+ ("kh" ?ⲭ)
+ ("Kh" ?Ⲭ)
+ ("l" ?ⲗ)
+ ("L" ?Ⲗ)
+ ("z" ?ⲍ)
+ ("Z" ?Ⲍ)
+ ("x" ?ⲝ)
+ ("X" ?Ⲝ)
+ ("`x" ?ϧ)
+ ("`X" ?Ϧ)
+ ("c" ?ϭ)
+ ("C" ?Ϭ)
+ ("v" ?ϥ)
+ ("V" ?Ϥ)
+ ("b" ?ⲃ)
+ ("B" ?Ⲃ)
+ ("n" ?ⲛ)
+ ("N" ?Ⲛ)
+ ("`n" ?⳯)
+ ("m" ?ⲙ)
+ ("M" ?Ⲙ)
+
+ ("`," ?⳰)
+ ("`<" ?⳱)
+ ("`." ?⳾)
+ ("`/" ?⳿))
+
(provide 'misc-lang)
;;; misc-lang.el ends here
diff --git a/lisp/leim/quail/slovak.el b/lisp/leim/quail/slovak.el
index acde11d02a..8ddd92d5b4 100644
--- a/lisp/leim/quail/slovak.el
+++ b/lisp/leim/quail/slovak.el
@@ -3,7 +3,8 @@
;; Copyright (C) 1998, 2001-2022 Free Software Foundation, Inc.
;; Authors: Tibor Šimko <tibor.simko@fmph.uniba.sk>
-;; Milan Zamazal <pdm@zamazal.org>
+;; Milan Zamazal <pdm@zamazal.org>
+;; Rudolf Adamkovič <salutis@me.com>
;; Maintainer: Pavel Janík <Pavel@Janik.cz>
;; Keywords: i18n, multilingual, input method, Slovak
@@ -25,8 +26,9 @@
;;; Commentary:
;; This file defines the following Slovak keyboards:
-;; - standard Slovak keyboard
+;; - standard Slovak keyboards, QWERTZ and QWERTY variants
;; - three Slovak keyboards for programmers
+;; LocalWords: QWERTZ
;;; Code:
@@ -35,7 +37,7 @@
(quail-define-package
"slovak" "Slovak" "SK" t
- "Standard Slovak keyboard."
+ "Standard Slovak QWERTZ keyboard."
nil t nil nil t nil nil nil nil nil t)
(quail-define-rules
@@ -154,6 +156,123 @@
("+0" ?\)))
+(quail-define-package
+ "slovak-qwerty" "Slovak" "SK" t
+ "Standard Slovak QWERTY keyboard."
+ nil t nil nil t nil nil nil nil nil t)
+
+(quail-define-rules
+ ("1" ?+)
+ ("2" ?ľ)
+ ("3" ?š)
+ ("4" ?č)
+ ("5" ?ť)
+ ("6" ?ž)
+ ("7" ?ý)
+ ("8" ?á)
+ ("9" ?í)
+ ("0" ?é)
+ ("!" ?1)
+ ("@" ?2)
+ ("#" ?3)
+ ("$" ?4)
+ ("%" ?5)
+ ("^" ?6)
+ ("&" ?7)
+ ("*" ?8)
+ ("(" ?9)
+ (")" ?0)
+ ("-" ?=)
+ ("_" ?%)
+ ("=" ?')
+ ("[" ?ú)
+ ("{" ?/)
+ ("]" ?ä)
+ ("}" ?\()
+ ("\\" ?ň)
+ ("|" ?\))
+ (";" ?ô)
+ (":" ?\")
+ ("'" ?§)
+ ("\"" ?!)
+ ("<" ??)
+ (">" ?:)
+ ("/" ?-)
+ ("?" ?_)
+ ("`" ?\;)
+ ("~" ?^)
+ ("=a" ?á)
+ ("+a" ?ä)
+ ("+=a" ?ä)
+ ("+c" ?č)
+ ("+d" ?ď)
+ ("=e" ?é)
+ ("+e" ?ě)
+ ("=i" ?í)
+ ("=l" ?ĺ)
+ ("+l" ?ľ)
+ ("+n" ?ň)
+ ("=o" ?ó)
+ ("+o" ?ô)
+ ("~o" ?ô)
+ ("+=o" ?ö)
+ ("=r" ?ŕ)
+ ("+r" ?ř)
+ ("=s" ?ß)
+ ("+s" ?š)
+ ("+t" ?ť)
+ ("=u" ?ú)
+ ("+u" ?ů)
+ ("+=u" ?ü)
+ ("=y" ?ý)
+ ("+z" ?ž)
+ ("=A" ?Á)
+ ("+A" ?Ä)
+ ("+=A" ?Ä)
+ ("+C" ?Č)
+ ("+D" ?Ď)
+ ("=E" ?É)
+ ("+E" ?Ě)
+ ("=I" ?Í)
+ ("=L" ?Ĺ)
+ ("+L" ?Ľ)
+ ("+N" ?Ň)
+ ("=O" ?Ó)
+ ("+O" ?Ô)
+ ("~O" ?Ô)
+ ("+=O" ?Ö)
+ ("=R" ?Ŕ)
+ ("+R" ?Ř)
+ ("=S" ?ß)
+ ("+S" ?Š)
+ ("+T" ?Ť)
+ ("=U" ?Ú)
+ ("+U" ?Ů)
+ ("+=U" ?Ü)
+ ("=Y" ?Ý)
+ ("+Z" ?Ž)
+ ("=q" ?`)
+ ("=2" ?@)
+ ("=3" ?#)
+ ("=4" ?$)
+ ("=5" ?%)
+ ("=6" ?^)
+ ("=7" ?&)
+ ("=8" ?*)
+ ("=9" ?\()
+ ("=0" ?\))
+ ("+1" ?!)
+ ("+2" ?@)
+ ("+3" ?#)
+ ("+4" ?$)
+ ("+5" ?%)
+ ("+6" ?^)
+ ("+7" ?&)
+ ("+8" ?*)
+ ("+9" ?\()
+ ("+0" ?\)))
+
+
(quail-define-package
"slovak-prog-1" "Slovak" "SK" t
"Slovak (non-standard) keyboard for programmers #1.
diff --git a/lisp/leim/quail/tibetan.el b/lisp/leim/quail/tibetan.el
index ca44f7022d..7f0848d04b 100644
--- a/lisp/leim/quail/tibetan.el
+++ b/lisp/leim/quail/tibetan.el
@@ -33,6 +33,13 @@
;;; Commentary:
+;; Note: This file includes several codepoints outside of the Unicode
+;; 0..#x10FFFF range, which are characters that were not unified into
+;; Unicode. Therefore, this file is encoded in utf-8-emacs, because
+;; UTF-8 cannot encode such codepoints. We include these codepoints
+;; literally in the file to have them displayed by suitable fonts,
+;; which makes maintenance easier.
+
;;; Code:
(require 'quail)
diff --git a/lisp/loadup.el b/lisp/loadup.el
index c01c827a75..2a9aff4c1f 100644
--- a/lisp/loadup.el
+++ b/lisp/loadup.el
@@ -366,6 +366,11 @@
(load "emacs-lisp/shorthands")
(load "emacs-lisp/eldoc")
+(load "emacs-lisp/cconv")
+(when (and (compiled-function-p (symbol-function 'cconv-fv))
+ (compiled-function-p (symbol-function 'macroexpand-all)))
+ (setq internal-make-interpreted-closure-function
+ #'cconv-make-interpreted-closure))
(load "cus-start") ;Late to reduce customize-rogue (needs loaddefs.el anyway)
(if (not (eq system-type 'ms-dos))
(load "tooltip"))
@@ -501,7 +506,10 @@ lost after dumping")))
bin-dest-dir)
;; Relative filename from the built uninstalled binary.
(file-relative-name file invocation-directory)))))
- comp-loaded-comp-units-h))))
+ comp-loaded-comp-units-h)))
+ ;; Set up the mechanism to allow inhibiting native-comp via
+ ;; file-local variables.
+ (defvar comp--no-native-compile (make-hash-table :test #'equal)))
(when (hash-table-p purify-flag)
(let ((strings 0)
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 2ae916e3ac..97d20cca15 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -131,17 +131,13 @@
;; feedmail-send-it. Hers's the best way to use the stuff in this
;; file:
;;
-;; Save this file as feedmail.el somewhere on your elisp loadpath;
-;; byte-compile it. Put the following lines in your init file:
+;; Put the following lines in your init file:
;;
;; (setq send-mail-function 'feedmail-send-it)
-;; (autoload 'feedmail-send-it "feedmail")
;;
;; If you plan to use the queue stuff, also use this:
;;
;; (setq feedmail-enable-queue t)
-;; (autoload 'feedmail-run-the-queue "feedmail")
-;; (autoload 'feedmail-run-the-queue-no-prompts "feedmail")
;; (setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist))
;;
;; though VM users might find it more comfortable to use this instead of
@@ -174,11 +170,6 @@
;; like to add the suffix ".fqm" to the list of non-saved things via the
variable
;; desktop-files-not-to-save.
;;
-;; If you are planning to call feedmail-queue-reminder from your .emacs or
-;; something similar, you might need this:
-;;
-;; (autoload 'feedmail-queue-reminder "feedmail")
-;;
;; If you ever use rmail-resend and queue messages, you should do this:
;;
;; (setq feedmail-queue-alternative-mail-header-separator "")
@@ -2775,7 +2766,7 @@ return that value."
(cond
;; nil means do nothing
((eq nil feedmail-date-generator) nil)
- ;; t is the same a using the function feedmail-default-date-generator, so
let it and recurse
+ ;; t is the same as using the function feedmail-default-date-generator, so
let it and recurse
((eq t feedmail-date-generator)
(let ((feedmail-date-generator (feedmail-default-date-generator
maybe-file)))
(feedmail-fiddle-date maybe-file)))
@@ -2831,7 +2822,7 @@ probably not appropriate for you."
(cond
;; nil means do nothing
((eq nil feedmail-message-id-generator) nil)
- ;; t is the same a using the function
feedmail-default-message-id-generator, so let it and recurse
+ ;; t is the same as using the function
feedmail-default-message-id-generator, so let it and recurse
((eq t feedmail-message-id-generator)
(let ((feedmail-message-id-generator
(feedmail-default-message-id-generator maybe-file)))
(feedmail-fiddle-message-id maybe-file)))
@@ -2873,7 +2864,7 @@ probably not appropriate for you."
(cond
;; nil means do nothing
((eq nil feedmail-x-mailer-line) nil)
- ;; t is the same a using the function feedmail-default-x-mailer-generator,
so let it and recurse
+ ;; t is the same as using the function feedmail-default-x-mailer-generator,
so let it and recurse
((eq t feedmail-x-mailer-line)
(let ((feedmail-x-mailer-line (feedmail-default-x-mailer-generator)))
(feedmail-fiddle-x-mailer)))
diff --git a/lisp/mail/ietf-drums-date.el b/lisp/mail/ietf-drums-date.el
index ddef7f11b6..034854dce5 100644
--- a/lisp/mail/ietf-drums-date.el
+++ b/lisp/mail/ietf-drums-date.el
@@ -126,7 +126,7 @@ treat them as whitespace (per RFC822)."
(defun ietf-drums-parse-date-string (time-string &optional error no-822)
"Parse an RFC5322 or RFC822 date, passed as TIME-STRING.
The optional ERROR parameter causes syntax errors to be flagged
-by signalling an instance of the date-parse-error condition. The
+by signaling an instance of the date-parse-error condition. The
optional NO-822 parameter disables the more lax RFC822 syntax,
which is permitted by default.
@@ -162,7 +162,7 @@ DST is returned as -1)."
(time (list nil nil nil nil nil nil nil -1 nil)))
(cl-labels ((set-matched-slot (slot index token)
;; Assign a slot value from match data if index is
- ;; non-nil, else from token, signalling an error if
+ ;; non-nil, else from token, signaling an error if
;; enabled and it's out of range.
(let ((value (if index
(cl-parse-integer (match-string index
token))
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index a13f9de174..9fb7b36e98 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -1,6 +1,6 @@
;;; mail-hist.el --- headers and message body history for outgoing mail -*-
lexical-binding: t; -*-
-;; Copyright (C) 1994, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2022 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Created: March, 1994
@@ -24,21 +24,15 @@
;;; Commentary:
-;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of
-;; time.
-;;
-;; To use this package, put it in a directory in your load-path, and
-;; put this in your init file:
+;; To use this package, add this to your init file:
;;
-;; (load "mail-hist" nil t)
+;; (require 'mail-hist)
;;
-;; Or you could do it with autoloads and hooks in your .emacs:
+;; Or you could do it with hooks in your .emacs:
;;
-;; (add-hook 'mail-mode-hook 'mail-hist-define-keys)
-;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)
-;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc
-;; (autoload 'mail-hist-define-keys "mail-hist")
-;; (autoload 'mail-hist-put-headers-into-history "mail-hist")
+;; (add-hook 'mail-mode-hook 'mail-hist-define-keys)
+;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)
+;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc
;;
;; Once it's installed, use M-p and M-n from mail headers to recover
;; previous/next contents in the history for that header, or, in the
@@ -51,6 +45,9 @@
;; point, so that you can mix the histories of different messages
;; easily. This might be confusing at times, but there should be no
;; problems that undo can't handle.
+;;
+;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of
+;; time.
;;; Code:
(require 'ring)
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index 324165a8ff..231fa69baa 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -357,7 +357,7 @@ mail-sending package is used for editing and sending the
message."
(goto-char final-resting-place))
(set-marker final-resting-place nil))
- ;; save initial text and set up the `no-empty-submission' hook.
+ ;; save initial text and set up the no empty submission hook.
;; This only works for mailers that support a pre-send hook, and
;; for which the paradigm has a non-nil value for the `hookvar'
;; key in its agent (i.e. sendmail.el's mail-send-hook).
diff --git a/lisp/mail/rfc6068.el b/lisp/mail/rfc6068.el
index 54035b6698..4863f3582c 100644
--- a/lisp/mail/rfc6068.el
+++ b/lisp/mail/rfc6068.el
@@ -43,9 +43,9 @@ string instead of decoding as utf-8."
(defun rfc6068-parse-mailto-url (mailto-url)
"Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
-MAILTO-URL should be a RFC 6068 (mailto) compliant url. A cons cell w/ a
+MAILTO-URL should be a RFC 6068 (mailto) compliant url. A cons cell with a
key of `Body' is a special case and is considered a header for this purpose.
-The returned alist is intended for use w/ the `compose-mail' interface.
+The returned alist is intended for use with the `compose-mail' interface.
Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g., & -> &), before
calling this function."
(let ((case-fold-search t)
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 812e9a201b..2421b283e6 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1751,6 +1751,7 @@ not be a new one). It returns non-nil if it got any new
messages."
(spam-filter-p (and (featurep 'rmail-spam-filter)
rmail-use-spam-filter))
(blurb "")
+ (mod-p (buffer-modified-p))
result success suffix)
(narrow-to-region (point) (point))
;; Read in the contents of the inbox files, renaming them as
@@ -1766,10 +1767,11 @@ not be a new one). It returns non-nil if it got any
new messages."
(rmail-insert-inbox-text files nil)
(setq delete-files (rmail-insert-inbox-text files t))))
;; If there was no new mail, or we aborted before actually
- ;; trying to get any, mark buffer unmodified. Otherwise the
- ;; buffer is correctly marked modified and the file locked
- ;; until we save out the new mail.
- (if (= (point-min) (point-max))
+ ;; trying to get any, mark buffer unmodified, unless it was
+ ;; modified originally. Otherwise the buffer is correctly
+ ;; marked modified and the file locked until we save out the
+ ;; new mail.
+ (if (and (null mod-p) (= (point-min) (point-max)))
(set-buffer-modified-p nil)))
;; Scan the new text and convert each message to
;; Rmail/mbox format.
@@ -2597,7 +2599,7 @@ is greater than zero; otherwise, show it in full."
"Handle a \"Mail-Followup-To\" header field with an unknown mailing list.
Ask the user whether to add that list name to `mail-mailing-lists'."
;; FIXME s-r not needed? Use rmail-get-header?
- ;; We have not narrowed to the headers at ths point?
+ ;; We have not narrowed to the headers at this point?
(save-restriction
(let ((mail-followup-to (mail-fetch-field "mail-followup-to" nil t)))
(when mail-followup-to
@@ -4693,15 +4695,23 @@ Argument MIME is non-nil if this is a mime message."
(save-excursion
(goto-char (point-min))
(while (re-search-forward "--------------[0-9a-zA-Z]+\n" nil t)
- (let ((delim (concat (substring (match-string 0) 0 -1) "--\n")))
+ ;; The ending delimiter is a start delimiter if another section follows.
+ ;; Otherwise it is an end delimiter, with -- affixed.
+ (let ((delim (concat (substring (match-string 0) 0 -1) "\\(\\|--\\)\n")))
(when (looking-at "\
Content-Type: text/[a-z]+; charset=UTF-8; format=flowed
Content-Transfer-Encoding: base64\n")
(goto-char (match-end 0))
+ ;; Sometimes the attachment's headers are followed by blank lines
+ (while (eolp)
+ (forward-line 1))
(let ((start (point))
(inhibit-read-only t))
- (search-forward delim)
+ (re-search-forward delim)
(forward-line -1)
+ ;; Sometimes the attachment's contents are followed by blank lines
+ (while (save-excursion (forward-line -1) (eolp))
+ (forward-line -1))
(base64-decode-region start (point))
(forward-line 1)))))))
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index b959f45250..b30c32aaff 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -50,6 +50,40 @@ Setting this option to nil might speed up the generation of
summaries."
:type 'boolean
:group 'rmail-summary)
+(defcustom rmail-summary-progressively-narrow nil
+ "Non-nil means progressively narrow the set of messages produced by summary.
+This allows to apply the summary criteria on top one another,
+thus progressively narrowing the selection of the messages produced
+by each summary criteria.
+For example, applying `rmail-summary-by-senders' on top
+of `rmail-summary-by-topic' produces a summary of messages
+with the specified Subjects that were sent from specified
+sending addresses.
+This way, the user can apply one summary on top of another,
+and keep narrowing the resulting list of messages."
+ :type 'boolean
+ :version "29.1"
+ :group 'rmail-summary)
+
+(defvar rmail-summary-currently-displayed-msgs nil
+ "Boolean vector that tells which messages are displayed in the summary.
+First element is ignored. Used when applying rmail-summary-by-*
+commands consecutively. Filled by
+`rmail-summary-populate-displayed-messages'.")
+(put 'rmail-summary-currently-displayed-msgs 'permanent-local t)
+
+(defvar rmail-summary-message-ids-hash-table nil
+ "Hash table linking Message IDs of messages with their indices.")
+
+(defvar rmail-summary-subjects-hash-table nil
+ "Hash table linking subjects with index of the first message with that
subject.")
+
+(defvar rmail-summary-message-parents-vector nil
+ "Vector that holds a list of indices of parents for each message.
+Message A is parent to message B if the id of A appear in the
+References or In-reply-to fields of B, or if A is the first
+message with the same subject as B. First element is ignored.")
+
(defvar rmail-summary-font-lock-keywords
'(("^ *[0-9]+D.*" . font-lock-string-face) ; Deleted.
("^ *[0-9]+-.*" . font-lock-type-face) ; Unread.
@@ -267,12 +301,149 @@ Setting this option to nil might speed up the generation
of summaries."
(defun rmail-update-summary (&rest _)
(apply (car rmail-summary-redo) (cdr rmail-summary-redo)))
+(defun rmail-summary-populate-displayed-messages ()
+ "Populate the `rmail-summary-currently-displayed-msgs' vector."
+ (with-current-buffer rmail-buffer
+ (let ((totmsgs rmail-total-messages))
+ (with-current-buffer rmail-summary-buffer
+ (setq rmail-summary-currently-displayed-msgs
+ (make-bool-vector (1+ totmsgs) nil))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (aset rmail-summary-currently-displayed-msgs
+ (string-to-number (thing-at-point 'line))
+ t)
+ (forward-line 1))))))
+
+(defun rmail-summary-fill-message-ids-hash-table ()
+ "Fill `rmail-summary-message-ids-hash-table'."
+ (with-current-buffer rmail-buffer
+ (setq rmail-summary-message-ids-hash-table (make-hash-table :test 'equal
:size 1024))
+ (let ((msgnum 1))
+ (while (<= msgnum rmail-total-messages)
+ (let ((id (rmail-get-header "Message-ID" msgnum)))
+ (puthash id (cons (cons id msgnum) (gethash id
rmail-summary-message-ids-hash-table))
+ rmail-summary-message-ids-hash-table))
+ (setq msgnum (1+ msgnum))))))
+
+(defun rmail-summary--split-header-field (name &optional msgnum)
+ (let ((header (rmail-get-header name msgnum)))
+ (if header
+ (split-string header "[ \f\t\n\r\v,;]+"))))
+
+(defun rmail-summary-fill-message-parents-vector ()
+ "Fill `rmail-summary-message-parents-vector'."
+ (with-current-buffer rmail-buffer
+ (rmail-summary-fill-message-ids-hash-table)
+ (setq rmail-summary-subjects-hash-table
+ (make-hash-table :test 'equal :size 1024))
+ (setq rmail-summary-message-parents-vector
+ (make-vector (1+ rmail-total-messages) nil))
+ (let ((msgnum 1))
+ (while (<= msgnum rmail-total-messages)
+ (let* ((parents nil)
+ (subject (rmail-simplified-subject msgnum))
+ (subj-cell (gethash subject rmail-summary-subjects-hash-table))
+ (subj-par (assoc subject subj-cell))
+ (refs (rmail-summary--split-header-field "References" msgnum))
+ (reply-to (rmail-summary--split-header-field "In-reply-to"
+ msgnum)))
+ (if subj-par
+ (setq parents (cons (cdr subj-par) parents))
+ (puthash subject (cons (cons subject msgnum) subj-cell)
+ rmail-summary-subjects-hash-table))
+ (dolist (id (append refs reply-to))
+ (let ((ent
+ (assoc id
+ (gethash id rmail-summary-message-ids-hash-table))))
+ (if ent
+ (setq parents (cons (cdr ent) parents)))))
+ (aset rmail-summary-message-parents-vector msgnum parents)
+ (setq msgnum (1+ msgnum)))))))
+
+(defun rmail-summary-invert ()
+ "Invert the criteria of the current summary.
+That is, show the messages that are not displayed, and hide
+the messages that are displayed."
+ (interactive)
+ (rmail-summary-populate-displayed-messages)
+ (rmail-new-summary "Invert"
+ '(rmail-summary-by-regexp ".*")
+ (lambda (msg)
+ (if
+ (not (aref rmail-summary-currently-displayed-msgs
msg))
+ (aset rmail-summary-currently-displayed-msgs msg t)
+ (aset rmail-summary-currently-displayed-msgs msg
nil)))))
+
+(defun rmail-summary--exists-1 ()
+ "Like `rmail-summary-exists', but works in both main and summary buffers."
+ (with-current-buffer rmail-buffer
+ (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
+ rmail-summary-buffer)))
+
;;;###autoload
(defun rmail-summary ()
"Display a summary of all messages, one line per message."
(interactive)
(rmail-new-summary "All" '(rmail-summary) nil))
+(defun rmail-summary-direct-descendants (msgnum encountered-msgs)
+ "Find all direct descendants of MSGNUM, ignoring ENCOUNTERED-MSGS.
+Assumes `rmail-summary-message-parents-vector' is filled. Ignores messages
+already ticked in ENCOUNTERED-MSGS."
+ (let (desc
+ (msg 1))
+ (while (<= msg rmail-total-messages)
+ (when (and
+ (not (aref encountered-msgs msg))
+ (memq msgnum (aref rmail-summary-message-parents-vector msg)))
+ (setq desc (cons msg desc)))
+ (setq msg (1+ msg)))
+ desc))
+
+(defun rmail-summary--walk-thread-message-recursively (msgnum encountered-msgs)
+ "Add parents and descendants of message MSGNUM to ENCOUNTERED-MSGS,
recursively."
+ (unless (aref encountered-msgs msgnum)
+ (aset encountered-msgs msgnum t)
+ (let ((walk-thread-msg
+ (lambda (msg)
+ (rmail-summary--walk-thread-message-recursively
+ msg encountered-msgs))))
+ (mapc walk-thread-msg
+ (aref rmail-summary-message-parents-vector msgnum))
+ (mapc walk-thread-msg
+ (rmail-summary-direct-descendants msgnum encountered-msgs)))))
+
+;;;###autoload
+(defun rmail-summary-by-thread (&optional msgnum)
+ "Display a summary of messages in the same discussion thread as MSGNUM.
+Interactively, prompt for MSGNUM, defaulting to the current message.
+Threads are based on the \"Subject\", \"References\" and \"In-reply-to\"
+headers of the messages."
+ (interactive
+ (let* ((msg rmail-current-message)
+ (prompt (concat "Show thread containing message number")))
+ (list (read-number prompt msg))))
+ (with-current-buffer rmail-buffer
+ (unless msgnum
+ (setq msgnum rmail-current-message))
+ (unless (and rmail-summary-message-parents-vector
+ (= (length rmail-summary-message-parents-vector)
+ (1+ rmail-total-messages)))
+ (rmail-summary-fill-message-parents-vector))
+ (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil)))
+ (rmail-summary--walk-thread-message-recursively msgnum enc-msgs)
+ (rmail-new-summary (format "thread containing message %d" msgnum)
+ (list 'rmail-summary-by-thread msgnum)
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (lambda (msg _msgnum)
+ (and (aref
rmail-summary-currently-displayed-msgs msg)
+ (aref enc-msgs msg)))
+ (lambda (msg _msgnum)
+ (aref enc-msgs msg)))
+ msgnum))))
+
;;;###autoload
(defun rmail-summary-by-labels (labels)
"Display a summary of all messages with one or more LABELS.
@@ -282,9 +453,17 @@ LABELS should be a string containing the desired labels,
separated by commas."
(setq labels (or rmail-last-multi-labels
(error "No label specified"))))
(setq rmail-last-multi-labels labels)
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (rmail-summary-populate-displayed-messages))
(rmail-new-summary (concat "labels " labels)
(list 'rmail-summary-by-labels labels)
- 'rmail-message-labels-p
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (lambda (msg l)
+ (and (aref rmail-summary-currently-displayed-msgs
msg)
+ (rmail-message-labels-p msg l)))
+ 'rmail-message-labels-p)
(concat " \\("
(mail-comma-list-regexp labels)
"\\)\\(,\\|\\'\\)")))
@@ -297,10 +476,19 @@ but if PRIMARY-ONLY is non-nil (prefix arg given),
only look in the To and From fields.
RECIPIENTS is a regular expression."
(interactive "sRecipients to summarize by: \nP")
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (rmail-summary-populate-displayed-messages))
(rmail-new-summary
(concat "recipients " recipients)
(list 'rmail-summary-by-recipients recipients primary-only)
- 'rmail-message-recipients-p recipients primary-only))
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (lambda (msg r &optional po)
+ (and (aref rmail-summary-currently-displayed-msgs msg)
+ (rmail-message-recipients-p msg r po)))
+ 'rmail-message-recipients-p)
+ recipients primary-only))
(defun rmail-message-recipients-p (msg recipients &optional primary-only)
(rmail-apply-in-message msg 'rmail-message-recipients-p-1
@@ -328,9 +516,17 @@ Emacs will list the message in the summary."
(setq regexp (or rmail-last-regexp
(error "No regexp specified"))))
(setq rmail-last-regexp regexp)
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (rmail-summary-populate-displayed-messages))
(rmail-new-summary (concat "regexp " regexp)
(list 'rmail-summary-by-regexp regexp)
- 'rmail-message-regexp-p
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (lambda (msg r)
+ (and (aref rmail-summary-currently-displayed-msgs
msg)
+ (rmail-message-regexp-p msg r)))
+ 'rmail-message-regexp-p)
regexp))
(defun rmail-message-regexp-p (msg regexp)
@@ -365,7 +561,7 @@ Emacs will list the message in the summary."
;;;###autoload
(defun rmail-summary-by-topic (subject &optional whole-message)
"Display a summary of all messages with the given SUBJECT.
-Normally checks just the Subject field of headers; but with prefix
+Normally checks just the Subject field of headers; but when prefix
argument WHOLE-MESSAGE is non-nil, looks in the whole message.
SUBJECT is a regular expression."
(interactive
@@ -376,10 +572,19 @@ SUBJECT is a regular expression."
(if subject ", default current subject" "")
"): ")))
(list (read-string prompt nil nil subject) current-prefix-arg)))
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (rmail-summary-populate-displayed-messages))
(rmail-new-summary
(concat "about " subject)
(list 'rmail-summary-by-topic subject whole-message)
- 'rmail-message-subject-p subject whole-message))
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (lambda (msg s &optional wm)
+ (and (aref rmail-summary-currently-displayed-msgs msg)
+ (rmail-message-subject-p msg s wm)))
+ 'rmail-message-subject-p)
+ subject whole-message))
(defun rmail-message-subject-p (msg subject &optional whole-message)
(if whole-message
@@ -402,9 +607,19 @@ sender of the current message."
(if sender ", default this message's sender" "")
"): ")))
(list (read-string prompt nil nil sender))))
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (rmail-summary-populate-displayed-messages))
(rmail-new-summary
(concat "senders " senders)
- (list 'rmail-summary-by-senders senders) 'rmail-message-senders-p senders))
+ (list 'rmail-summary-by-senders senders)
+ (if (and rmail-summary-progressively-narrow
+ (rmail-summary--exists-1))
+ (lambda (msg s)
+ (and (aref rmail-summary-currently-displayed-msgs msg)
+ (rmail-message-senders-p msg s)))
+ 'rmail-message-senders-p)
+ senders))
(defun rmail-message-senders-p (msg senders)
(string-match senders (or (rmail-get-header "From" msg) "")))
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 387792eb31..3f75faa077 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -550,10 +550,10 @@ This also saves the value of `send-mail-function' via
Customize."
#'mail-send-and-exit)
;;;###autoload
-(defun sendmail-user-agent-compose (&optional to subject other-headers
- continue switch-function yank-action
- send-actions return-action
- &rest ignored)
+(defun sendmail-user-agent-compose ( &optional to subject other-headers
+ continue switch-function yank-action
+ send-actions return-action
+ &rest _ignored )
(if switch-function
(funcall switch-function "*mail*"))
(let ((cc (cdr (assoc-string "cc" other-headers t)))
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 98f46a3af5..558785de14 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -1350,7 +1350,7 @@ buffer."
nesting)))
(defun sc-add-citation-level ()
- "Add a citation level for nested citation style w/ coercion."
+ "Add a citation level for nested citation style with coercion."
(let* ((nesting (sc-guess-nesting))
(citation (make-string (1+ (length nesting))
(string-to-char sc-citation-delimiter)))
diff --git a/lisp/man.el b/lisp/man.el
index 7ba7bee417..3802362da0 100644
--- a/lisp/man.el
+++ b/lisp/man.el
@@ -331,7 +331,7 @@ This regexp should not start with a `^' character.")
;; This used to have leading space [ \t]*, but was removed because it
;; causes false page splits on an occasional NAME with leading space
;; inside a manpage. And `Man-heading-regexp' doesn't have [ \t]* anyway.
-(defvar Man-first-heading-regexp "^NAME$\\|^[ \t]*No manual entry fo.*$"
+(defvar Man-first-heading-regexp "^NAME$\\|^[ \t]*No manual entry for.*$"
"Regular expression describing first heading on a manpage.
This regular expression should start with a `^' character.")
@@ -451,50 +451,45 @@ Otherwise, the value is whatever the function
table)
"Syntax table used in Man mode buffers.")
-(defvar Man-mode-map
- (let ((map (make-sparse-keymap)))
- (suppress-keymap map)
- (set-keymap-parent map
- (make-composed-keymap button-buffer-map special-mode-map))
-
- (define-key map "n" 'Man-next-section)
- (define-key map "p" 'Man-previous-section)
- (define-key map "\en" 'Man-next-manpage)
- (define-key map "\ep" 'Man-previous-manpage)
- (define-key map "." 'beginning-of-buffer)
- (define-key map "r" 'Man-follow-manual-reference)
- (define-key map "g" 'Man-goto-section)
- (define-key map "s" 'Man-goto-see-also-section)
- (define-key map "k" 'Man-kill)
- (define-key map "u" 'Man-update-manpage)
- (define-key map "m" 'man)
- ;; Not all the man references get buttons currently. The text in the
- ;; manual page can contain references to other man pages
- (define-key map "\r" 'man-follow)
-
- (easy-menu-define nil map
- "`Man-mode' menu."
- '("Man"
- ["Next Section" Man-next-section t]
- ["Previous Section" Man-previous-section t]
- ["Go To Section..." Man-goto-section t]
- ["Go To \"SEE ALSO\" Section" Man-goto-see-also-section
- :active (cl-member Man-see-also-regexp Man--sections
- :test #'string-match-p)]
- ["Follow Reference..." Man-follow-manual-reference
- :active Man--refpages
- :help "Go to a manpage referred to in the \"SEE ALSO\" section"]
- "--"
- ["Next Manpage" Man-next-manpage
- :active (> (length Man-page-list) 1)]
- ["Previous Manpage" Man-previous-manpage
- :active (> (length Man-page-list) 1)]
- "--"
- ["Man..." man t]
- ["Kill Buffer" Man-kill t]
- ["Quit" quit-window t]))
- map)
- "Keymap for Man mode.")
+(defvar-keymap Man-mode-map
+ :doc "Keymap for Man mode."
+ :suppress t
+ :parent (make-composed-keymap button-buffer-map special-mode-map)
+ "n" #'Man-next-section
+ "p" #'Man-previous-section
+ "M-n" #'Man-next-manpage
+ "M-p" #'Man-previous-manpage
+ "." #'beginning-of-buffer
+ "r" #'Man-follow-manual-reference
+ "g" #'Man-goto-section
+ "s" #'Man-goto-see-also-section
+ "k" #'Man-kill
+ "u" #'Man-update-manpage
+ "m" #'man
+ ;; Not all the man references get buttons currently. The text in the
+ ;; manual page can contain references to other man pages
+ "RET" #'man-follow
+
+ :menu
+ '("Man"
+ ["Next Section" Man-next-section t]
+ ["Previous Section" Man-previous-section t]
+ ["Go To Section..." Man-goto-section t]
+ ["Go To \"SEE ALSO\" Section" Man-goto-see-also-section
+ :active (cl-member Man-see-also-regexp Man--sections
+ :test #'string-match-p)]
+ ["Follow Reference..." Man-follow-manual-reference
+ :active Man--refpages
+ :help "Go to a manpage referred to in the \"SEE ALSO\" section"]
+ "--"
+ ["Next Manpage" Man-next-manpage
+ :active (> (length Man-page-list) 1)]
+ ["Previous Manpage" Man-previous-manpage
+ :active (> (length Man-page-list) 1)]
+ "--"
+ ["Man..." man t]
+ ["Kill Buffer" Man-kill t]
+ ["Quit" quit-window t]))
;; buttons
(define-button-type 'Man-abstract-xref-man-page
@@ -1082,13 +1077,13 @@ to auto-complete your input based on the installed
manual pages."
;; unless COLUMNS or MANWIDTH is set. This isn't a problem on
;; a tty. man(1) says:
;; MANWIDTH
- ;; If $MANWIDTH is set, its value is used as the line
- ;; length for which manual pages should be formatted.
- ;; If it is not set, manual pages will be formatted
- ;; with a line length appropriate to the current ter-
- ;; minal (using an ioctl(2) if available, the value of
- ;; $COLUMNS, or falling back to 80 characters if nei-
- ;; ther is available).
+ ;; If $MANWIDTH is set, its value is used as the line
+ ;; length for which manual pages should be formatted.
+ ;; If it is not set, manual pages will be formatted
+ ;; with a line length appropriate to the current
+ ;; terminal (using an ioctl(2) if available, the value
+ ;; of $COLUMNS, or falling back to 80 characters if
+ ;; neither is available).
(when (or window-system
(not (or (getenv "MANWIDTH") (getenv "COLUMNS"))))
;; Since the page buffer is displayed beforehand,
diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el
index c2c18320b1..849e0f7723 100644
--- a/lisp/menu-bar.el
+++ b/lisp/menu-bar.el
@@ -527,12 +527,12 @@
`(menu-item "Paste" yank
:enable (funcall
',(lambda ()
- (and (or
+ (and (not buffer-read-only)
+ (or
(gui-backend-selection-exists-p
'CLIPBOARD)
(if (featurep 'ns) ; like paste-from-menu
(cdr yank-menu)
- kill-ring))
- (not buffer-read-only))))
+ kill-ring)))))
:help "Paste (yank) text most recently cut/copied"
:keys ,(lambda ()
(if cua-mode
@@ -1847,6 +1847,10 @@ mail status in mode line"))
:help "Toggle automatic parsing in source code buffers
(Semantic mode)"
:button (:toggle . (bound-and-true-p semantic-mode))))
+ (bindings--define-key menu [eglot]
+ '(menu-item "Language Server Support (Eglot)" eglot
+ :help "Start language server suitable for this buffer's
major-mode"))
+
(bindings--define-key menu [ede]
'(menu-item "Project Support (EDE)"
global-ede-mode
diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1
index 00e52df2bb..d6893fb9ec 100644
--- a/lisp/mh-e/ChangeLog.1
+++ b/lisp/mh-e/ChangeLog.1
@@ -2944,7 +2944,7 @@
change fixes that.
* mh-utils.el (mh-show-mode): Setup mh-show-mode to display
- elipsis for truncated header fields and to skip over them quickly.
+ ellipsis for truncated header fields and to skip over them quickly.
(mh-clean-msg-header): Make another pass over the message header
fields truncating long headers.
@@ -8064,7 +8064,7 @@
* mh-e.el (mh-last-msg): Add call to mh-recenter.
-2002-10-26 Peter S Galbraith <psg@debia.org>
+2002-10-26 Peter S Galbraith <psg@debian.org>
* mh-comp.el (mh-search-addr-regexp, mh-re-search-to-cc): Remove
`mh-re-search-to-cc' in favor of more generalized new function
diff --git a/lisp/mh-e/ChangeLog.2 b/lisp/mh-e/ChangeLog.2
index 5f2dd299f8..fd597f0c00 100644
--- a/lisp/mh-e/ChangeLog.2
+++ b/lisp/mh-e/ChangeLog.2
@@ -360,8 +360,8 @@
2011-05-10 Jim Meyering <meyering@redhat.com>
Fix doubled-word typos.
- * mh-alias.el (mh-alias-minibuffer-confirm-address): if if -> if it
- * mh-scan.el (mh-scan-destination-width): in in -> in
+ * mh-alias.el (mh-alias-minibuffer-confirm-address):
+ * mh-scan.el (mh-scan-destination-width): Fix typos.
2011-04-28 Stefan Monnier <monnier@iro.umontreal.ca>
diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el
index be1b7642eb..38a8216dc0 100644
--- a/lisp/mh-e/mh-junk.el
+++ b/lisp/mh-e/mh-junk.el
@@ -402,7 +402,7 @@ information can be used so that you can replace multiple
Bogofilter is a Bayesian spam filtering program. Get it from your
local distribution or from the bogofilter web site at URL
-`http://bogofilter.sourceforge.net/'.
+`https://bogofilter.sourceforge.io/'.
Bogofilter is taught by running:
@@ -487,7 +487,7 @@ See `mh-bogofilter-blocklist' for more information."
SpamProbe is a Bayesian spam filtering program. Get it from your
local distribution or from the SpamProbe web site at URL
-`http://spamprobe.sourceforge.net'.
+`https://spamprobe.sourceforge.net'.
To use SpamProbe, add the following recipes to \".procmailrc\":
diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el
index 316463b989..c0b42171b9 100644
--- a/lisp/mh-e/mh-mime.el
+++ b/lisp/mh-e/mh-mime.el
@@ -607,8 +607,9 @@ If no part is preferred then all the parts are displayed."
(defun mh-mime-maybe-display-alternatives (alternatives)
"Show buttons for ALTERNATIVES.
-If `mh-mime-display-alternatives-flag' is non-nil then display
-buttons for alternative parts that are usually suppressed."
+If `mh-display-buttons-for-alternatives-flag' is non-nil then
+display buttons for alternative parts that are usually
+suppressed."
(when (and mh-display-buttons-for-alternatives-flag alternatives)
(insert "\n----------------------------------------------------\n")
(insert "Alternatives:\n")
diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el
index 4b4c594286..abbf7422b5 100644
--- a/lisp/mh-e/mh-scan.el
+++ b/lisp/mh-e/mh-scan.el
@@ -279,9 +279,9 @@ as in the default of
^ *[0-9]+.\\\\([bct]\\\\).....[ ]*\\\\(..................\\\\)
If this regular expression is not correct, the notation hints
-will not be highlighted with the face
-`mh-mh-folder-sent-to-me-hint' and the sender will not be
-highlighted with the face `mh-folder-sent-to-me-sender'.")
+will not be highlighted with the face `mh-folder-sent-to-me-hint'
+and the sender will not be highlighted with the face
+`mh-folder-sent-to-me-sender'.")
(defvar mh-scan-subject-regexp
"^ *[0-9]+........[
]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)"
diff --git a/lisp/minibuf-eldef.el b/lisp/minibuf-eldef.el
index ba7e68eb81..935c9111ee 100644
--- a/lisp/minibuf-eldef.el
+++ b/lisp/minibuf-eldef.el
@@ -110,8 +110,7 @@ should be displayed in its place.")
"Set up a minibuffer for `minibuffer-electric-default-mode'.
The prompt and initial input should already have been inserted."
(let ((regexps minibuffer-default-in-prompt-regexps)
- (match nil)
- (inhibit-point-motion-hooks t))
+ (match nil))
(save-excursion
(save-restriction
;; Narrow to only the prompt.
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 9f26e4f7f9..6bb0fa3ae9 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -850,7 +850,88 @@ via `set-message-function'."
;; was handled specially by this function.
t))))
-(setq set-message-function 'set-minibuffer-message)
+(setq set-message-function 'set-message-functions)
+
+(defcustom set-message-functions '(set-minibuffer-message)
+ "List of functions to handle display of echo-area messages.
+Each function is called with one argument that is the text of a message.
+If a function returns nil, a previous message string is given to the
+next function in the list, and if the last function returns nil, the
+last message string is displayed in the echo area.
+If a function returns a string, the returned string is given to the
+next function in the list, and if the last function returns a string,
+it's displayed in the echo area.
+If a function returns any other non-nil value, no more functions are
+called from the list, and no message will be displayed in the echo area."
+ :type '(choice (const :tag "No special message handling" nil)
+ (repeat
+ (choice (function-item :tag "Inhibit some messages"
+ inhibit-message)
+ (function-item :tag "Accumulate messages"
+ set-multi-message)
+ (function-item :tag "Handle minibuffer"
+ set-minibuffer-message)
+ (function :tag "Custom function"))))
+ :version "29.1")
+
+(defun set-message-functions (message)
+ (run-hook-wrapped 'set-message-functions
+ (lambda (fun)
+ (when (stringp message)
+ (let ((ret (funcall fun message)))
+ (when ret (setq message ret))))
+ nil))
+ message)
+
+(defcustom inhibit-message-regexps nil
+ "List of regexps that inhibit messages by the function `inhibit-message'."
+ :type '(repeat regexp)
+ :version "29.1")
+
+(defun inhibit-message (message)
+ "Don't display MESSAGE when it matches the regexp `inhibit-message-regexps'.
+This function is intended to be added to `set-message-functions'."
+ (or (and (consp inhibit-message-regexps)
+ (string-match-p (mapconcat #'identity inhibit-message-regexps "\\|")
+ message))
+ message))
+
+(defcustom multi-message-timeout 2
+ "Number of seconds between messages before clearing the accumulated list."
+ :type 'number
+ :version "29.1")
+
+(defcustom multi-message-max 8
+ "Max size of the list of accumulated messages."
+ :type 'number
+ :version "29.1")
+
+(defvar multi-message-separator "\n")
+
+(defvar multi-message-list nil)
+
+(defun set-multi-message (message)
+ "Return recent messages as one string to display in the echo area.
+Note that this feature works best only when `resize-mini-windows'
+is at its default value `grow-only'."
+ (let ((last-message (car multi-message-list)))
+ (unless (and last-message (equal message (aref last-message 1)))
+ (when last-message
+ (cond
+ ((> (float-time) (+ (aref last-message 0) multi-message-timeout))
+ (setq multi-message-list nil))
+ ((or
+ ;; `message-log-max' was nil, potential clutter.
+ (aref last-message 2)
+ ;; Remove old message that is substring of the new message
+ (string-prefix-p (aref last-message 1) message))
+ (setq multi-message-list (cdr multi-message-list)))))
+ (push (vector (float-time) message (not message-log-max))
multi-message-list)
+ (when (> (length multi-message-list) multi-message-max)
+ (setf (nthcdr multi-message-max multi-message-list) nil)))
+ (mapconcat (lambda (m) (aref m 1))
+ (reverse multi-message-list)
+ multi-message-separator)))
(defun clear-minibuffer-message ()
"Clear minibuffer message.
@@ -972,10 +1053,18 @@ ALL-COMPLETIONS is the function that lists the
completions (it should
follow the calling convention of `completion-all-completions'),
and DOC describes the way this style of completion works.")
+(defun completion--update-styles-options (widget)
+ "Function to keep updated the options in `completion-category-overrides'."
+ (let ((lst (mapcar (lambda (x)
+ (list 'const (car x)))
+ completion-styles-alist)))
+ (widget-put widget :args (mapcar #'widget-convert lst))
+ widget))
+
(defconst completion--styles-type
`(repeat :tag "insert a new menu to add more styles"
- (choice ,@(mapcar (lambda (x) (list 'const (car x)))
- completion-styles-alist))))
+ (choice :convert-widget completion--update-styles-options)))
+
(defconst completion--cycling-threshold-type
'(choice (const :tag "No cycling" nil)
(const :tag "Always cycle" t)
@@ -1237,9 +1326,9 @@ pair of a group title string and a list of group
candidate strings."
:version "28.1")
(defface completions-group-separator
- '((t :inherit shadow :strike-through t))
+ '((t :inherit shadow :underline t))
"Face used for the separator lines between the candidate groups."
- :version "28.1")
+ :version "29.1")
(defun completion--cycle-threshold (metadata)
(let* ((cat (completion-metadata-get metadata 'category))
diff --git a/lisp/mpc.el b/lisp/mpc.el
index 1775e7d5e7..f878c6ca29 100644
--- a/lisp/mpc.el
+++ b/lisp/mpc.el
@@ -447,7 +447,7 @@ which will be concatenated with proper quoting before
passing them to MPD."
;;; Support for regularly updated current status information ;;;;;;;;;;;;;;;
;; Exported elements:
-;; `mpc-status' holds the uptodate data.
+;; `mpc-status' holds the up-to-date data.
;; `mpc-status-callbacks' holds the registered callback functions.
;; `mpc-status-refresh' forces a refresh of the data.
;; `mpc-status-stop' stops the automatic updating.
diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el
index 6ffa65a2dd..d6d0fb9a25 100644
--- a/lisp/net/ange-ftp.el
+++ b/lisp/net/ange-ftp.el
@@ -4242,7 +4242,7 @@ directory, so that Emacs will know its current contents."
((eq identification 'localname) localname)
(t (ange-ftp-replace-name-component file ""))))))
-(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
+(defun ange-ftp-load (file &optional noerror nomessage nosuffix must-suffix)
(if (ange-ftp-ftp-name file)
(let ((tryfiles (if nosuffix
(list file)
@@ -4264,7 +4264,7 @@ directory, so that Emacs will know its current contents."
(or noerror
(signal 'file-error (list "Cannot open load file" file)))
nil))
- (ange-ftp-real-load file noerror nomessage nosuffix)))
+ (ange-ftp-real-load file noerror nomessage nosuffix must-suffix)))
;; Calculate default-unhandled-directory for a given ange-ftp buffer.
(defun ange-ftp-unhandled-file-name-directory (_filename)
diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el
index 2d528c4862..7ac6396d31 100644
--- a/lisp/net/browse-url.el
+++ b/lisp/net/browse-url.el
@@ -222,6 +222,14 @@ be used instead."
(function :tag "Other function"))
:version "26.1")
+(defcustom browse-url-irc-function 'browse-url-irc
+ "Function to open an irc:// link."
+ :type '(choice
+ (function-item :tag "Emacs IRC" :value browse-url-irc)
+ (const :tag "None" nil)
+ (function :tag "Other function"))
+ :version "29.1")
+
(defcustom browse-url-button-regexp
(concat
"\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|gemini\\|"
@@ -547,6 +555,11 @@ process), or nil (we don't know)."
(function-put 'browse-url--man 'browse-url-browser-kind
#'browse-url--browser-kind-man)
+(defun browse-url--irc (url &rest args)
+ "Call `browse-url-irc-function' with URL and ARGS."
+ (funcall browse-url-irc-function url args))
+(function-put 'browse-url--irc 'browse-url-browser-kind 'internal)
+
(defun browse-url--browser (url &rest args)
"Call `browse-url-browser-function' with URL and ARGS."
(funcall browse-url-browser-function url args))
@@ -565,6 +578,7 @@ process), or nil (we don't know)."
(defvar browse-url-default-handlers
'(("\\`mailto:"; . browse-url--mailto)
("\\`man:" . browse-url--man)
+ ("\\`irc6?s?://" . browse-url--irc)
(browse-url--non-html-file-url-p . browse-url-emacs))
"Like `browse-url-handlers' but populated by Emacs and packages.
@@ -1294,6 +1308,11 @@ currently selected window instead."
(let ((file (url-unhex-string (url-filename parsed))))
(when-let ((coding (browse-url--file-name-coding-system)))
(setq file (decode-coding-string file 'utf-8)))
+ ;; The local-part of file: URLs on Windows is supposed to
+ ;; start with an extra slash.
+ (when (eq system-type 'windows-nt)
+ (setq file (replace-regexp-in-string
+ "\\`/\\([a-z]:\\)" "\\1" file)))
(funcall func file))
(let ((file-name-handler-alist
(cons (cons url-handler-regexp 'url-file-handler)
@@ -1505,6 +1524,16 @@ used instead of `browse-url-new-window-flag'."
(function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal)
+;; --- irc ---
+
+;;;###autoload
+(defun browse-url-irc (url &rest _)
+ "Call `url-irc' directly after parsing URL.
+This function is a fit for options like `gnus-button-alist'."
+ (url-irc (url-generic-parse-url url)))
+
+(function-put 'browse-url-irc 'browse-url-browser-kind 'internal)
+
;; --- mailto ---
(autoload 'rfc6068-parse-mailto-url "rfc6068")
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el
index 6c978c5a5f..9f0ad7b83c 100644
--- a/lisp/net/dbus.el
+++ b/lisp/net/dbus.el
@@ -37,6 +37,7 @@
(declare-function dbus-message-internal "dbusbind.c")
(declare-function dbus--init-bus "dbusbind.c")
(declare-function libxml-parse-xml-region "xml.c")
+(defvar dbus-debug)
(defvar dbus-message-type-invalid)
(defvar dbus-message-type-method-call)
(defvar dbus-message-type-method-return)
diff --git a/lisp/net/dictionary.el b/lisp/net/dictionary.el
index 4c52382c67..315f7e5f52 100644
--- a/lisp/net/dictionary.el
+++ b/lisp/net/dictionary.el
@@ -341,7 +341,8 @@ is utf-8"
"p" #'backward-button
"SPC" #'scroll-up-command
"S-SPC" #'scroll-down-command
- "M-SPC" #'scroll-down-command)
+ "M-SPC" #'scroll-down-command
+ "DEL" #'scroll-down-command)
(defvar dictionary-connection
nil
@@ -1150,9 +1151,7 @@ It presents the selection or word at point as default
input and
allows editing it."
(interactive
(list (let ((default (dictionary-search-default)))
- (read-string (if default
- (format "Search word (%s): " default)
- "Search word: ")
+ (read-string (format-prompt "Search word" default)
nil 'dictionary-word-history default))
(if current-prefix-arg
(read-string (if dictionary-default-dictionary
@@ -1173,7 +1172,10 @@ allows editing it."
(defun dictionary-lookup-definition ()
"Unconditionally lookup the word at point."
(interactive)
- (dictionary-new-search (cons (current-word) dictionary-default-dictionary)))
+ (let ((word (current-word)))
+ (unless word
+ (error "No word at point"))
+ (dictionary-new-search (cons word dictionary-default-dictionary))))
(defun dictionary-previous ()
"Go to the previous location in the current buffer."
diff --git a/lisp/net/eudc-capf.el b/lisp/net/eudc-capf.el
index 92f0c80493..e2bbd5b28b 100644
--- a/lisp/net/eudc-capf.el
+++ b/lisp/net/eudc-capf.el
@@ -123,11 +123,12 @@ queried for email addresses, and the results delivered to
(match-end 0)))
(end (point))
(prefix (save-excursion (buffer-substring-no-properties beg
end))))
- (list beg end
- (completion-table-with-cache
- (lambda (_)
- (eudc-query-with-words (split-string prefix "[ \t]+") t))
- t))))))
+ (let ((result
+ (eudc-query-with-words (split-string prefix "[ \t]+") t)))
+ (when result
+ (list beg end
+ (completion-table-with-cache
+ (lambda (_) result) t))))))))
(provide 'eudc-capf)
;;; eudc-capf.el ends here
diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el
index dea17f3424..450943a3f0 100644
--- a/lisp/net/eudc-vars.el
+++ b/lisp/net/eudc-vars.el
@@ -38,6 +38,9 @@
(defcustom eudc-server nil
"The name or IP address of the directory server.
+This variable is deprecated as of Emacs 29.1. Please add an
+entry to `eudc-server-hotlist' instead of setting `eudc-server'.
+
A port number may be specified by appending a colon and a
number to the name of the server. Use `localhost' if the directory
server resides on your computer (BBDB backend).
@@ -48,7 +51,7 @@ instead."
;; Known protocols (used in completion)
;; Not to be mistaken with `eudc-supported-protocols'
-(defvar eudc-known-protocols '(bbdb ldap))
+(defvar eudc-known-protocols '(bbdb ldap ecomplete mailabbrev))
(defcustom eudc-server-hotlist nil
"Directory servers to query.
@@ -343,9 +346,15 @@ arguments that should be passed to the program."
:inline t
(string :tag "Argument")))))
+(defcustom eudc-ignore-options-file nil
+ "Ignore configuration in `eudc-options-file', if non-nil."
+ :type 'boolean
+ :version "29.1")
+
(defcustom eudc-options-file
(locate-user-emacs-file "eudc-options" ".eudc-options")
- "A file where the `servers' hotlist is stored."
+ "A file where the `servers' hotlist is stored.
+See `eudc-ignore-options-file'."
:type '(file :Tag "File Name:")
:version "25.1")
diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el
index 40cb25fca2..8319c048e2 100644
--- a/lisp/net/eudc.el
+++ b/lisp/net/eudc.el
@@ -106,44 +106,39 @@
;; Split the string just in case.
(version<= "3" (car (split-string bbdb-version)))))
+(defun eudc--plist-member (plist prop &optional predicate)
+ "Like `plist-member', but signal on invalid PLIST."
+ (or (plistp plist)
+ (signal 'wrong-type-argument `(plistp ,plist)))
+ (plist-member plist prop predicate))
+
(defun eudc-plist-member (plist prop)
- "Return t if PROP has a value specified in PLIST."
- (if (not (= 0 (% (length plist) 2)))
- (error "Malformed plist"))
- (catch 'found
- (while plist
- (if (eq prop (car plist))
- (throw 'found t))
- (setq plist (cdr (cdr plist))))
- nil))
+ "Return t if PROP has a value specified in PLIST.
+Signal an error if PLIST is not a valid property list."
+ (and (eudc--plist-member plist prop) t))
-;; Emacs's plist-get lacks third parameter
+;; Emacs's `plist-get' lacks a default parameter, and CL-Lib's
+;; `cl-getf' doesn't accept a predicate or signal an error.
(defun eudc-plist-get (plist prop &optional default)
- "Extract a value from a property list.
-PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2...). This function returns the value
-corresponding to the given PROP, or DEFAULT if PROP is not
-one of the properties on the list."
- (if (eudc-plist-member plist prop)
- (plist-get plist prop)
- default))
+ "Extract the value of PROP in property list PLIST.
+PLIST is a list of the form (PROP1 VALUE1 PROP2 VALUE2...).
+This function returns the first value corresponding to the given
+PROP, or DEFAULT if PROP is not one of the properties in the
+list. The comparison with PROP is done using `eq'. If PLIST is
+not a valid property list, this function signals an error."
+ (let ((tail (eudc--plist-member plist prop)))
+ (if tail (cadr tail) default)))
(defun eudc-lax-plist-get (plist prop &optional default)
- "Extract a value from a lax property list.
-
-PLIST is a lax property list, which is a list of the form (PROP1
-VALUE1 PROP2 VALUE2...), where comparisons between properties are done
-using `equal' instead of `eq'. This function returns the value
-corresponding to PROP, or DEFAULT if PROP is not one of the
-properties on the list."
- (if (not (= 0 (% (length plist) 2)))
- (error "Malformed plist"))
- (catch 'found
- (while plist
- (if (equal prop (car plist))
- (throw 'found (car (cdr plist))))
- (setq plist (cdr (cdr plist))))
- default))
+ "Extract the value of PROP from lax property list PLIST.
+PLIST is a list of the form (PROP1 VALUE1 PROP2 VALUE2...), where
+comparisons between properties are done using `equal' instead of
+`eq'. This function returns the first value corresponding to
+PROP, or DEFAULT if PROP is not one of the properties in the
+list. If PLIST is not a valid property list, this function
+signals an error."
+ (let ((tail (eudc--plist-member plist prop #'equal)))
+ (if tail (cadr tail) default)))
(defun eudc-replace-in-string (str regexp newtext)
"Replace all matches in STR for REGEXP with NEWTEXT.
@@ -731,7 +726,8 @@ server for future sessions."
(if (called-interactively-p 'interactive)
(message "Current directory server is now %s (%s)" eudc-server
eudc-protocol))
(if (null no-save)
- (eudc-save-options)))
+ (when (not eudc-ignore-options-file)
+ (eudc-save-options))))
;;;###autoload
(defun eudc-get-email (name &optional error)
@@ -1112,7 +1108,11 @@ queries the server for the existing fields and displays
a corresponding form."
(error "%s:%s is already in the hotlist" protocol server)
(setq eudc-server-hotlist (cons (cons server protocol)
eudc-server-hotlist))
(eudc-install-menu)
- (eudc-save-options)))
+ (if eudc-ignore-options-file
+ (warn "Not saving bookmark due to `eudc-ignore-options-file'\
+ customization. Instead, customize `eudc-server-hotlist' to include %s:%s"
+ protocol server)
+ (eudc-save-options))))
(defun eudc-bookmark-current-server ()
"Add current server to the EUDC `servers' hotlist."
@@ -1122,6 +1122,9 @@ queries the server for the existing fields and displays a
corresponding form."
(defun eudc-save-options ()
"Save options to `eudc-options-file'."
(interactive)
+ (when eudc-ignore-options-file
+ (error "EUDC is configured to ignore the deprecated options file;\
+ see `eudc-ignore-options-file'"))
(with-current-buffer (find-file-noselect eudc-options-file t)
(goto-char (point-min))
;; delete the previous setq
@@ -1283,11 +1286,13 @@ queries the server for the existing fields and displays
a corresponding form."
;;{{{ Load time initializations
;; Load the options file
-(if (and (not noninteractive)
- (and (locate-library eudc-options-file)
- (progn (message "") t)) ; Remove mode line message
- (not (featurep 'eudc-options-file)))
- (load eudc-options-file))
+(let ((library-file-path (locate-library eudc-options-file)))
+ (if (and (not noninteractive)
+ (and library-file-path
+ (progn (message "") t)) ; Remove mode line message
+ (not (featurep 'eudc-options-file))
+ (not eudc-ignore-options-file))
+ (load eudc-options-file)))
;; Install the full menu
(unless (featurep 'infodock)
diff --git a/lisp/net/eudcb-ecomplete.el b/lisp/net/eudcb-ecomplete.el
new file mode 100644
index 0000000000..55011d29f6
--- /dev/null
+++ b/lisp/net/eudcb-ecomplete.el
@@ -0,0 +1,108 @@
+;;; eudcb-ecomplete.el --- EUDC - ecomplete backend -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; Author: Alexander Adolf
+;;
+;; 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 library provides an interface to the ecomplete package as
+;; an EUDC data source.
+
+;;; Usage:
+;; No setup is required, since there is an entry for this backend
+;; in `eudc-server-hotlist' by default.
+;;
+;; For example, if your `ecomplete-database-file' (typically
+;; ~/.emacs.d/ecompleterc) contains:
+;;
+;; ((mail ("larsi@gnus.org" 38154 1516109510 "Lars <larsi@ecomplete.org>")))
+;;
+;; Then:
+;;
+;; C-x m lars C-u M-x eudc-expand-try-all RET
+;;
+;; should expand the email address into the To: field of the new
+;; message.
+
+;;; Code:
+
+(require 'eudc)
+(require 'ecomplete)
+(require 'mail-parse)
+
+(defvar eudc-ecomplete-attributes-translation-alist
+ '((email . mail))
+ "See `eudc-protocol-attributes-translation-alist'.
+The back-end-specific attribute names are used as the \"type\" of
+entry when searching, and they must hence match the types you use
+in your ecompleterc database file.")
+
+;; hook ourselves into the EUDC framework
+(eudc-protocol-set 'eudc-query-function
+ 'eudc-ecomplete-query-internal
+ 'ecomplete)
+(eudc-protocol-set 'eudc-list-attributes-function
+ nil
+ 'ecomplete)
+(eudc-protocol-set 'eudc-protocol-attributes-translation-alist
+ 'eudc-ecomplete-attributes-translation-alist
+ 'ecomplete)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes
+ nil
+ 'ecomplete)
+
+;;;###autoload
+(defun eudc-ecomplete-query-internal (query &optional _return-attrs)
+ "Query `ecomplete' with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE). Since `ecomplete'
+does not provide attributes in the usual sense, the
+back-end-specific attribute names in
+`eudc-ecomplete-attributes-translation-alist' are used as the
+KEY (that is, the \"type\" of match) when looking for matches in
+`ecomplete-database'.
+
+RETURN-ATTRS is ignored." ; FIXME: why is this being ignored?
+ (ecomplete-setup)
+ (let ((email-attr (car (eudc-translate-attribute-list '(email))))
+ result)
+ (dolist (term query)
+ (let* ((attr (car term))
+ (value (cdr term))
+ (matches (ecomplete-get-matches attr value)))
+ (when matches
+ (dolist (match (split-string (string-trim (substring-no-properties
+ matches))
+ "[\n\r]"))
+ ;; Try to decompose the email address.
+ (let* ((decoded (mail-header-parse-address match t))
+ (name (cdr decoded))
+ (email (car decoded)))
+ (if (and decoded (eq attr email-attr))
+ ;; The email could be decomposed, push individual
+ ;; fields.
+ (push `((,attr . ,email)
+ ,@(when name (list (cons 'name name))))
+ result)
+ ;; Otherwise just forward the value as-is.
+ (push (list (cons attr match)) result)))))))
+ result))
+
+(eudc-register-protocol 'ecomplete)
+
+(provide 'eudcb-ecomplete)
+;;; eudcb-ecomplete.el ends here
diff --git a/lisp/net/eudcb-mailabbrev.el b/lisp/net/eudcb-mailabbrev.el
new file mode 100644
index 0000000000..4a2dd9ad4a
--- /dev/null
+++ b/lisp/net/eudcb-mailabbrev.el
@@ -0,0 +1,130 @@
+;;; eudcb-mailabbrev.el --- EUDC - mailabbrev backend -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;
+;; Author: Alexander Adolf
+;;
+;; 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 library provides an interface to the mailabbrev package as
+;; an EUDC data source.
+
+;;; Usage:
+;; No setup is required, since there is an entry for this backend
+;; in `eudc-server-hotlist' by default.
+;;
+;; For example, if your `mail-personal-alias-file' (typically
+;; ~/.mailrc) contains:
+;;
+;; alias lars "Lars <larsi@mail-abbrev.com>"
+;;
+;; Then:
+;;
+;; C-x m lars C-u M-x eudc-expand-try-all RET
+;;
+;; will expand the correct email address into the To: field of the
+;; new message.
+
+;;; Code:
+
+(require 'eudc)
+(require 'mailabbrev)
+(require 'mail-parse)
+
+;; hook ourselves into the EUDC framework
+(eudc-protocol-set 'eudc-query-function
+ 'eudc-mailabbrev-query-internal
+ 'mailabbrev)
+(eudc-protocol-set 'eudc-list-attributes-function
+ nil
+ 'mailabbrev)
+(eudc-protocol-set 'eudc-protocol-attributes-translation-alist
+ nil
+ 'mailabbrev)
+(eudc-protocol-set 'eudc-protocol-has-default-query-attributes
+ nil
+ 'mailabbrev)
+;;;###autoload
+(defun eudc-mailabbrev-query-internal (query &optional _return-attrs)
+ "Query `mailabbrev' with QUERY.
+QUERY is a list of cons cells (ATTR . VALUE). Since `mailabbrev'
+does not provide attributes in the usual sense, only the email,
+name, and firstname attributes in the QUERY are considered, and
+their values are matched against the alias names in the mailrc
+file. When a mailrc alias is a distribution list, that is it
+expands to more that one email address, the individual recipient
+specifications are formatted using `eudc-rfc5322-make-address',
+and returned as a comma-separated list in the email address
+attribute.
+
+RETURN-ATTRS is a list of attributes to return, defaulting to
+`eudc-default-return-attributes'."
+ (mail-abbrevs-setup)
+ (let (result)
+ (dolist (term query)
+ (let* ((attr (car term))
+ (value (cdr term))
+ (soft (intern-soft value mail-abbrevs))
+ (raw-matches (and
+ (boundp soft)
+ (symbol-value soft))))
+ (when (and raw-matches
+ (memq attr '(email firstname name)))
+ (let* ((matches (split-string raw-matches ", "))
+ (num-matches (length matches)))
+ (if (> num-matches 1)
+ ;; multiple matches: distribution list
+ (let ((distr-str (string)))
+ (dolist (recipient matches)
+ ;; try to decompose email construct
+ (let* ((decoded (mail-header-parse-address recipient t))
+ (name (cdr decoded))
+ (email (car decoded)))
+ (if decoded
+ ;; decoding worked, push rfc5322 rendered address
+ (setq distr-str
+ (copy-sequence
+ (concat distr-str ", "
+ (eudc-rfc5322-make-address email
+ nil
+ name))))
+ ;; else, just forward the value as-is
+ (setq distr-str
+ (copy-sequence
+ (concat distr-str ", " recipient))))))
+ ;; push result, removing the leading ", "
+ (push (list (cons 'email (substring distr-str 2 -1)))
+ result))
+ ;; simple case: single match
+ (let* ((match (car matches))
+ (decoded (mail-header-parse-address match t))
+ (name (cdr decoded))
+ (email (car decoded)))
+ (if decoded
+ ;; decoding worked, push individual fields
+ (push `((email . ,email)
+ ,@(when name (list (cons 'name name))))
+ result)
+ ;; else, just forward the value as-is
+ (push (list (cons 'email match)) result))))))))
+ result))
+
+(eudc-register-protocol 'mailabbrev)
+
+(provide 'eudcb-mailabbrev)
+
+;;; eudcb-mailabbrev.el ends here
diff --git a/lisp/net/eww.el b/lisp/net/eww.el
index 414de931c4..3799ef96e8 100644
--- a/lisp/net/eww.el
+++ b/lisp/net/eww.el
@@ -1596,7 +1596,8 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(list :eww-form eww-form
:value value
:type "textarea"
- :name (dom-attr dom 'name)))))
+ :name (dom-attr dom 'name)))
+ (put-text-property start (1+ start) 'shr-tab-stop t)))
(defun eww-tag-input (dom)
(let ((type (downcase (or (dom-attr dom 'type) "text")))
@@ -1660,7 +1661,8 @@ See URL
`https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.")
(add-face-text-property start (point) 'eww-form-select)
(put-text-property start (point) 'keymap eww-select-map)
(unless (= start (point))
- (put-text-property start (1+ start) 'help-echo "select field"))
+ (put-text-property start (1+ start) 'help-echo "select field")
+ (put-text-property start (1+ start) 'shr-tab-stop t))
(shr-ensure-paragraph))))
(defun eww-select-display (select)
diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el
index 99ed14ca8b..86cf98004b 100644
--- a/lisp/net/goto-addr.el
+++ b/lisp/net/goto-addr.el
@@ -164,52 +164,51 @@ and `goto-address-fontify-p'."
;; Clean up from any previous go.
(goto-address-unfontify (or start (point-min)) (or end (point-max)))
(save-excursion
- (let ((inhibit-point-motion-hooks t))
+ (goto-char (or start (point-min)))
+ (when (or (eq t goto-address-fontify-maximum-size)
+ (< (- (or end (point-max)) (point))
+ goto-address-fontify-maximum-size))
+ (while (re-search-forward goto-address-url-regexp end t)
+ (let* ((s (match-beginning 0))
+ (e (match-end 0))
+ this-overlay)
+ (when (or (not goto-address-prog-mode)
+ ;; This tests for both comment and string
+ ;; syntax.
+ (nth 8 (syntax-ppss)))
+ (setq this-overlay (make-overlay s e))
+ (and goto-address-fontify-p
+ (overlay-put this-overlay 'face goto-address-url-face))
+ (overlay-put this-overlay 'evaporate t)
+ (overlay-put this-overlay
+ 'mouse-face goto-address-url-mouse-face)
+ (overlay-put this-overlay 'follow-link t)
+ (overlay-put this-overlay
+ 'help-echo "mouse-2, C-c RET: follow URL")
+ (overlay-put this-overlay
+ 'keymap goto-address-highlight-keymap)
+ (overlay-put this-overlay 'goto-address t))))
(goto-char (or start (point-min)))
- (when (or (eq t goto-address-fontify-maximum-size)
- (< (- (or end (point-max)) (point))
- goto-address-fontify-maximum-size))
- (while (re-search-forward goto-address-url-regexp end t)
- (let* ((s (match-beginning 0))
- (e (match-end 0))
- this-overlay)
- (when (or (not goto-address-prog-mode)
- ;; This tests for both comment and string
- ;; syntax.
- (nth 8 (syntax-ppss)))
- (setq this-overlay (make-overlay s e))
- (and goto-address-fontify-p
- (overlay-put this-overlay 'face goto-address-url-face))
- (overlay-put this-overlay 'evaporate t)
- (overlay-put this-overlay
- 'mouse-face goto-address-url-mouse-face)
- (overlay-put this-overlay 'follow-link t)
- (overlay-put this-overlay
- 'help-echo "mouse-2, C-c RET: follow URL")
- (overlay-put this-overlay
- 'keymap goto-address-highlight-keymap)
- (overlay-put this-overlay 'goto-address t))))
- (goto-char (or start (point-min)))
- (while (re-search-forward goto-address-mail-regexp end t)
- (let* ((s (match-beginning 0))
- (e (match-end 0))
- this-overlay)
- (when (or (not goto-address-prog-mode)
- ;; This tests for both comment and string
- ;; syntax.
- (nth 8 (syntax-ppss)))
- (setq this-overlay (make-overlay s e))
- (and goto-address-fontify-p
- (overlay-put this-overlay 'face goto-address-mail-face))
- (overlay-put this-overlay 'evaporate t)
- (overlay-put this-overlay 'mouse-face
- goto-address-mail-mouse-face)
- (overlay-put this-overlay 'follow-link t)
- (overlay-put this-overlay
- 'help-echo "mouse-2, C-c RET: mail this address")
- (overlay-put this-overlay
- 'keymap goto-address-highlight-keymap)
- (overlay-put this-overlay 'goto-address t))))))))
+ (while (re-search-forward goto-address-mail-regexp end t)
+ (let* ((s (match-beginning 0))
+ (e (match-end 0))
+ this-overlay)
+ (when (or (not goto-address-prog-mode)
+ ;; This tests for both comment and string
+ ;; syntax.
+ (nth 8 (syntax-ppss)))
+ (setq this-overlay (make-overlay s e))
+ (and goto-address-fontify-p
+ (overlay-put this-overlay 'face goto-address-mail-face))
+ (overlay-put this-overlay 'evaporate t)
+ (overlay-put this-overlay 'mouse-face
+ goto-address-mail-mouse-face)
+ (overlay-put this-overlay 'follow-link t)
+ (overlay-put this-overlay
+ 'help-echo "mouse-2, C-c RET: mail this address")
+ (overlay-put this-overlay
+ 'keymap goto-address-highlight-keymap)
+ (overlay-put this-overlay 'goto-address t)))))))
(defun goto-address-fontify-region (start end)
"Fontify URLs and e-mail addresses in the given region."
diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 062ff05d69..de553468b1 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -156,7 +156,7 @@ Valid properties include:
"The name of the ldapsearch command line program."
:type '(string :tag "`ldapsearch' Program"))
-(defcustom ldap-ldapsearch-args '("-LLL" "-tt")
+(defcustom ldap-ldapsearch-args nil
"A list of additional arguments to pass to `ldapsearch'."
:type '(repeat :tag "`ldapsearch' Arguments"
(string :tag "Argument")))
@@ -609,7 +609,8 @@ an alist of attribute/value pairs."
(sizelimit (plist-get search-plist 'sizelimit))
(withdn (plist-get search-plist 'withdn))
(numres 0)
- arglist dn name value record result)
+ (arglist (list "-LLL" "-tt"))
+ dn name value record result)
(if (or (null filter)
(equal "" filter))
(error "No search filter"))
@@ -715,14 +716,14 @@ an alist of attribute/value pairs."
(eq (string-match "/\\(.:.*\\)$" value) 0))
(setq value (match-string 1 value)))
;; Do not try to open non-existent files
- (if (equal value "")
- (setq value " ")
- (with-current-buffer bufval
+ (if (match-string 3)
+ (with-current-buffer bufval
(erase-buffer)
(set-buffer-multibyte nil)
(insert-file-contents-literally value)
(delete-file value)
- (setq value (buffer-string))))
+ (setq value (buffer-string)))
+ (setq value " "))
(setq record (cons (list name value)
record))
(forward-line 1))
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 38a5e14c94..2b7e539392 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -173,6 +173,9 @@ a greeting from the server.
:nowait, if non-nil, says the connection should be made
asynchronously, if possible.
+:noquery - when exiting Emacs and the network process is running,
+don't query the user if it's non-nil.
+
:shell-command is a `format-spec' string that can be used if
:type is `shell'. It has two specs, %s for host and %p for port
number. Example: \"ssh gateway nc %s %p\".
@@ -195,6 +198,7 @@ gnutls-boot (as returned by `gnutls-boot-parameters')."
(make-network-process :name name :buffer buffer
:host (puny-encode-domain host) :service service
:nowait (plist-get parameters :nowait)
+ :noquery (plist-get parameters :noquery)
:tls-parameters
(plist-get parameters :tls-parameters)
:coding (plist-get parameters :coding))
diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el
index f65ef522f2..af196ccecf 100644
--- a/lisp/net/newst-backend.el
+++ b/lisp/net/newst-backend.el
@@ -40,7 +40,6 @@
;; Silence warnings
(defvar newsticker-groups)
-(defvar w3m-minor-mode-map)
(defvar newsticker--retrieval-timer-list nil
"List of timers for news retrieval.
diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el
index fa481ce528..29957a62d0 100644
--- a/lisp/net/rcirc.el
+++ b/lisp/net/rcirc.el
@@ -1049,7 +1049,7 @@ Each element has the form (TYPE HANDLE), where TYPE is a
string
and HANDLE is either the symbol `immediate' or `deferred'.
Messages in an immediate batch are handled just like regular
messages, while deferred messages are stored in
-`rcirc-batch-messages'.")
+`rcirc-batched-messages'.")
(defvar-local rcirc-batch-attributes nil
"Alist mapping batch IDs to parameters.")
@@ -1353,10 +1353,10 @@ inserting the new one."
(if (use-region-p)
(let ((beg (region-beginning)))
(goto-char (region-end))
- (insert "")
+ (insert "\^O")
(goto-char beg)
(insert pre))
- (insert pre "")))
+ (insert pre "\^O")))
(when (or (not (region-active-p)) (< (point) (mark)))
(forward-char (length pre))))
@@ -1364,11 +1364,11 @@ inserting the new one."
"Remove the closes formatting found closes to the current point."
(interactive)
(save-excursion
- (when (and (search-backward-regexp (rx (or "" " " " " " " ""))
+ (when (and (search-backward-regexp (rx (or "\^B" "\^]" "\^_" "\^^" "\^Q"))
rcirc-prompt-end-marker t)
- (looking-at (rx (group (or "" " " " " " " ""))
+ (looking-at (rx (group (or "\^B" "\^]" "\^_" "\^^" "\^Q"))
(*? nonl)
- (group ""))))
+ (group "\^O"))))
(replace-match "" nil nil nil 2)
(replace-match "" nil nil nil 1))))
@@ -1378,7 +1378,7 @@ If REPLACE is non-nil or a prefix argument is given, any
prior
formatting will be replaced before the bold formatting is
inserted."
(interactive "P")
- (rcirc-format "" replace))
+ (rcirc-format "\^B" replace))
(defun rcirc-format-italic (replace)
"Insert italic formatting.
@@ -1386,7 +1386,7 @@ If REPLACE is non-nil or a prefix argument is given, any
prior
formatting will be replaced before the italic formatting is
inserted."
(interactive "P")
- (rcirc-format " " replace))
+ (rcirc-format "\^]" replace))
(defun rcirc-format-underline (replace)
"Insert underlining formatting.
@@ -1394,7 +1394,7 @@ If REPLACE is non-nil or a prefix argument is given, any
prior
formatting will be replaced before the underline formatting is
inserted."
(interactive "P")
- (rcirc-format " " replace))
+ (rcirc-format "\^_" replace))
(defun rcirc-format-strike-trough (replace)
"Insert strike-trough formatting.
@@ -1402,7 +1402,7 @@ If REPLACE is non-nil or a prefix argument is given, any
prior
formatting will be replaced before the strike-trough formatting
is inserted."
(interactive "P")
- (rcirc-format " " replace))
+ (rcirc-format "\^^" replace))
(defun rcirc-format-fixed-width (replace)
"Insert fixed-width formatting.
@@ -1410,7 +1410,7 @@ If REPLACE is non-nil or a prefix argument is given, any
prior
formatting will be replaced before the fixed width formatting is
inserted."
(interactive "P")
- (rcirc-format "" replace))
+ (rcirc-format "\^Q" replace))
(defvar-keymap rcirc-mode-map
:doc "Keymap for rcirc mode."
@@ -2066,7 +2066,8 @@ connection."
(set-marker-insertion-type rcirc-prompt-end-marker t)
;; run markup functions
- (cl-assert (bolp))
+ (unless (bolp)
+ (newline))
(save-excursion
(save-restriction
(narrow-to-region (point) (point))
@@ -2176,9 +2177,11 @@ connection."
(defun rcirc-generate-log-filename (process target)
"Return filename for log file based on PROCESS and TARGET."
- (if target
- (rcirc-generate-new-buffer-name process target)
- (process-name process)))
+ (concat
+ (if target
+ (rcirc-generate-new-buffer-name process target)
+ (process-name process))
+ ".log"))
(defcustom rcirc-log-filename-function 'rcirc-generate-log-filename
"A function to generate the filename used by rcirc's logging facility.
@@ -3018,11 +3021,7 @@ for nick completion."
:version "29.1")
(defface rcirc-bridged-nick
- '((((class color) (min-colors 88) (background light)) :background
"SlateGray1")
- (((class color) (min-colors 88) (background dark)) :background
"DarkSlateGray4")
- (((class color) (min-colors 16) (background light)) :background
"LightBlue")
- (((class color) (min-colors 16) (background dark)) :background
"DarkSlateGray")
- (t :background "blue"))
+ '((t :inherit highlight))
"Face used for pseudo-nick ."
:version "29.1")
diff --git a/lisp/net/sieve-manage.el b/lisp/net/sieve-manage.el
index 381e1fcd4f..b2caa62e51 100644
--- a/lisp/net/sieve-manage.el
+++ b/lisp/net/sieve-manage.el
@@ -385,7 +385,7 @@ Return the buffer associated with the connection."
(defun sieve-manage-open (server &optional port stream auth buffer)
"Open a network connection to a managesieve SERVER (string).
Optional argument PORT is port number (integer) on remote server.
-Optional argument STREAM is any of `sieve-manage-streams' (a symbol).
+Optional argument STREAM is any of `sieve-manage-stream' (a symbol).
Optional argument AUTH indicates authenticator to use, see
`sieve-manage-authenticators' for available authenticators.
If nil, chooses the best stream the server is capable of.
diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el
index 646ae86452..5b2af7c6b2 100644
--- a/lisp/net/tramp-archive.el
+++ b/lisp/net/tramp-archive.el
@@ -183,18 +183,20 @@ It must be supported by libarchive(3).")
;; The definition of `tramp-archive-file-name-regexp' contains calls
;; to `regexp-opt', which cannot be autoloaded while loading
;; loaddefs.el. So we use a macro, which is evaluated only when needed.
+;; When tramp-archive.el is unloaded and reloaded, it gripes about
+;; missing `tramp-archive{-compression]-suffixes'. We protect this.
;;;###autoload
(progn (defmacro tramp-archive-autoload-file-name-regexp ()
"Regular expression matching archive file names."
- `(rx
+ `(tramp-compat-rx
bos
;; This group is used in `tramp-archive-file-name-archive'.
(group
(+ nonl)
;; Default suffixes ...
- "." ,(cons '| tramp-archive-suffixes)
+ "." ,(cons '| (bound-and-true-p tramp-archive-suffixes))
;; ... with compression.
- (? "." ,(cons '| tramp-archive-compression-suffixes)))
+ (? "." ,(cons '| (bound-and-true-p tramp-archive-compression-suffixes))))
;; This group is used in `tramp-archive-file-name-localname'.
(group "/" (* nonl))
eos)))
@@ -330,10 +332,6 @@ arguments to pass to the OPERATION."
(inhibit-file-name-operation operation))
(apply operation args))))
-;; Starting with Emacs 29, `tramp-archive-file-name-handler' is
-;; autoloaded. But it must still be in tramp-loaddefs.el for older
-;; versions of Emacs.
-;;;###autoload(autoload 'tramp-archive-file-name-handler "tramp-archive")
;;;###tramp-autoload
(defun tramp-archive-file-name-handler (operation &rest args)
"Invoke the file archive related OPERATION.
@@ -396,30 +394,30 @@ arguments to pass to the OPERATION."
(put #'tramp-archive-autoload-file-name-handler 'tramp-autoload t)
;;;###autoload
-(progn (defun tramp-register-archive-file-name-handler ()
+(progn (defun tramp-register-archive-autoload-file-name-handler ()
"Add archive file name handler to `file-name-handler-alist'."
(when (and tramp-archive-enabled
(not
- (rassq #'tramp-archive-file-name-handler
file-name-handler-alist)))
+ (rassq 'tramp-archive-file-name-handler
file-name-handler-alist)))
(add-to-list 'file-name-handler-alist
(cons (tramp-archive-autoload-file-name-regexp)
#'tramp-archive-autoload-file-name-handler))
(put #'tramp-archive-autoload-file-name-handler 'safe-magic t))))
-(put #'tramp-register-archive-file-name-handler 'tramp-autoload t)
+(put #'tramp-register-archive-autoload-file-name-handler 'tramp-autoload t)
;;;###autoload
(progn
- (add-hook 'after-init-hook #'tramp-register-archive-file-name-handler)
+ (add-hook 'after-init-hook
#'tramp-register-archive-autoload-file-name-handler)
(add-hook
'tramp-archive-unload-hook
(lambda ()
(remove-hook
- 'after-init-hook #'tramp-register-archive-file-name-handler))))
+ 'after-init-hook #'tramp-register-archive-autoload-file-name-handler))))
;; In older Emacsen (prior 27.1), the autoload above does not exist.
;; So we call it again; it doesn't hurt.
-(tramp-register-archive-file-name-handler)
+(tramp-register-archive-autoload-file-name-handler)
;; Mark `operations' the handler is responsible for.
(put #'tramp-archive-file-name-handler 'operations
diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el
index 4d7d35a4de..912ea5f8bb 100644
--- a/lisp/net/tramp-cache.el
+++ b/lisp/net/tramp-cache.el
@@ -601,19 +601,30 @@ PROPERTIES is a list of file properties (strings)."
(remove-hook 'kill-emacs-hook
#'tramp-dump-connection-properties)))
+;;;###tramp-autoload
+(defcustom tramp-completion-use-cache t
+ "Whether to use the Tramp cache for completion of user and host names.
+Set it to nil if there are invalid entries in the cache, for
+example if the host configuration changes often, or if you plug
+your laptop to different networks frequently."
+ :group 'tramp
+ :version "29.1"
+ :type 'boolean)
+
;;;###tramp-autoload
(defun tramp-parse-connection-properties (method)
"Return a list of (user host) tuples allowed to access for METHOD.
This function is added always in `tramp-get-completion-function'
for all methods. Resulting data are derived from connection history."
- (mapcar
- (lambda (key)
- (and (tramp-file-name-p key)
- (string-equal method (tramp-file-name-method key))
- (not (tramp-file-name-localname key))
- (list (tramp-file-name-user key)
- (tramp-file-name-host key))))
- (hash-table-keys tramp-cache-data)))
+ (and tramp-completion-use-cache
+ (mapcar
+ (lambda (key)
+ (and (tramp-file-name-p key)
+ (string-equal method (tramp-file-name-method key))
+ (not (tramp-file-name-localname key))
+ (list (tramp-file-name-user key)
+ (tramp-file-name-host key))))
+ (hash-table-keys tramp-cache-data))))
;; When "emacs -Q" has been called, both variables are nil. We do not
;; load the persistency file then, in order to have a clean test environment.
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index a1d1d284ed..252eab0f3b 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -179,7 +179,7 @@ A nil value for either argument stands for the current
time."
(lambda (reporter &optional value _suffix)
(progress-reporter-update reporter value))))
-;; `ignore-error' is new in Emacs Emacs 27.1.
+;; `ignore-error' is new in Emacs 27.1.
(defmacro tramp-compat-ignore-error (condition &rest body)
"Execute BODY; if the error CONDITION occurs, return nil.
Otherwise, return result of last form in BODY.
diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el
index e104babed2..7b94253226 100644
--- a/lisp/net/tramp-container.el
+++ b/lisp/net/tramp-container.el
@@ -101,7 +101,8 @@
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
- (when-let ((raw-list (shell-command-to-string
+ (when-let ((default-directory tramp-compat-temporary-file-directory)
+ (raw-list (shell-command-to-string
(concat tramp-docker-program
" ps --format '{{.ID}}\t{{.Names}}'")))
(lines (split-string raw-list "\n" 'omit))
@@ -121,7 +122,8 @@ see its function help for a description of the format."
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
- (when-let ((raw-list (shell-command-to-string
+ (when-let ((default-directory tramp-compat-temporary-file-directory)
+ (raw-list (shell-command-to-string
(concat tramp-kubernetes-program
" get pods --no-headers "
"-o custom-columns=NAME:.metadata.name")))
@@ -130,6 +132,24 @@ see its function help for a description of the format."
(list nil name))
names)))
+(defun tramp-kubernetes--current-context-data (vec)
+ "Return Kubernetes current context data as JSON string."
+ (with-temp-buffer
+ (when (zerop
+ (tramp-call-process
+ vec tramp-kubernetes-program nil t nil
+ "config" "current-context"))
+ (goto-char (point-min))
+ (let ((current-context (buffer-substring (point) (line-end-position))))
+ (erase-buffer)
+ (when (zerop
+ (tramp-call-process
+ vec tramp-kubernetes-program nil t nil
+ "config" "view" "-o"
+ (format
+ "jsonpath='{.contexts[?(@.name == \"%s\")]}'"
current-context)))
+ (buffer-string))))))
+
;;;###tramp-autoload
(defvar tramp-default-remote-shell) ;; Silence byte compiler.
@@ -143,6 +163,7 @@ see its function help for a description of the format."
("-u" "%u")
("%h")
("%l")))
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-i" "-c"))))
@@ -154,6 +175,7 @@ see its function help for a description of the format."
("-u" "%u")
("%h")
("%l")))
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-i" "-c"))))
@@ -165,6 +187,8 @@ see its function help for a description of the format."
("-it")
("--")
("%l")))
+ (tramp-config-check tramp-kubernetes--current-context-data)
+ (tramp-direct-async (,tramp-default-remote-shell "-c"))
(tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-i" "-c"))))
diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el
index 16c4049a68..0973258157 100644
--- a/lisp/net/tramp-crypt.el
+++ b/lisp/net/tramp-crypt.el
@@ -455,7 +455,7 @@ Otherwise, return NAME."
(defun tramp-crypt-do-encrypt-or-decrypt-file (op root infile outfile)
"Encrypt / decrypt file INFILE to OUTFILE according to encrypted directory
ROOT.
Both files must be local files. OP must be `encrypt' or `decrypt'.
-If OP ist `decrypt', the basename of INFILE must be an encrypted file name.
+If OP is `decrypt', the basename of INFILE must be an encrypted file name.
Raise an error if this fails."
(when-let ((tramp-crypt-enabled t)
(dir (tramp-crypt-file-name-p root))
diff --git a/lisp/net/tramp-integration.el b/lisp/net/tramp-integration.el
index 35c0636b1c..78107e1a03 100644
--- a/lisp/net/tramp-integration.el
+++ b/lisp/net/tramp-integration.el
@@ -125,6 +125,8 @@ been set up by `rfn-eshadow-setup-minibuffer'."
;; eshell.el keeps the path in `eshell-path-env'. We must change it
;; when `default-directory' points to another host.
+;; This is fixed in Eshell with Emacs 29.1.
+
(defun tramp-eshell-directory-change ()
"Set `eshell-path-env' to $PATH of the host related to `default-directory'."
;; Remove last element of `(exec-path)', which is `exec-directory'.
@@ -136,16 +138,17 @@ been set up by `rfn-eshadow-setup-minibuffer'."
(getenv "PATH"))))
(with-eval-after-load 'esh-util
- (add-hook 'eshell-mode-hook
- #'tramp-eshell-directory-change)
- (add-hook 'eshell-directory-change-hook
- #'tramp-eshell-directory-change)
- (add-hook 'tramp-integration-unload-hook
- (lambda ()
- (remove-hook 'eshell-mode-hook
- #'tramp-eshell-directory-change)
- (remove-hook 'eshell-directory-change-hook
- #'tramp-eshell-directory-change))))
+ (unless (boundp 'eshell-path-env-list)
+ (add-hook 'eshell-mode-hook
+ #'tramp-eshell-directory-change)
+ (add-hook 'eshell-directory-change-hook
+ #'tramp-eshell-directory-change)
+ (add-hook 'tramp-integration-unload-hook
+ (lambda ()
+ (remove-hook 'eshell-mode-hook
+ #'tramp-eshell-directory-change)
+ (remove-hook 'eshell-directory-change-hook
+ #'tramp-eshell-directory-change)))))
;;; Integration of recentf.el:
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 3240f5352a..cfecd32aba 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -789,8 +789,8 @@ use strict;
use warnings;
use POSIX qw(getgroups);
-my ($user, $passwd, $uid, $gid) = getpwuid $< ;
-my $group = getgrgid $gid ;
+my ( $uid, $user ) = ( $>, scalar getpwuid $> );
+my ( $gid, $group ) = ( $), scalar getgrgid $) );
my @groups = map { $_ . \"(\" . getgrgid ($_) . \")\" } getgroups ();
printf \"uid=%%d(%%s) gid=%%d(%%s) groups=%%s\\n\",
@@ -2827,11 +2827,14 @@ the result will be a local, non-Tramp, file name."
;; Handle empty NAME.
(when (zerop (length name)) (setq name "."))
;; On MS Windows, some special file names are not returned properly
- ;; by `file-name-absolute-p'.
- (if (and (eq system-type 'windows-nt)
- (string-match-p
- (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device)
eol)))
- name))
+ ;; by `file-name-absolute-p'. If `tramp-syntax' is `simplified',
+ ;; there could be the falso positive "/:".
+ (if (or (and (eq system-type 'windows-nt)
+ (string-match-p
+ (tramp-compat-rx bol (| (: alpha ":") (: (literal null-device)
eol)))
+ name))
+ (and (not (tramp-tramp-file-p name))
+ (not (tramp-tramp-file-p dir))))
(tramp-run-real-handler #'expand-file-name (list name dir))
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
@@ -4469,7 +4472,8 @@ process to set up. VEC specifies the connection."
;; Check whether the output of "uname -sr" has been changed. If
;; yes, this is a strong indication that we must expire all
;; connection properties. We start again with
- ;; `tramp-maybe-open-connection', it will be caught there.
+ ;; `tramp-maybe-open-connection', it will be caught there. The same
+ ;; check will be applied with the function kept in `tramp-config-check'.
(tramp-message vec 5 "Checking system information")
(let* ((old-uname (tramp-get-connection-property vec "uname"))
(uname
@@ -4478,8 +4482,23 @@ process to set up. VEC specifies the connection."
old-uname
(tramp-set-connection-property
vec "uname"
- (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\"")))))
- (when (and (stringp old-uname) (not (string-equal old-uname uname)))
+ (tramp-send-command-and-read vec "echo \\\"`uname -sr`\\\""))))
+ (config-check-function
+ (tramp-get-method-parameter vec 'tramp-config-check))
+ (old-config-check
+ (and config-check-function
+ (tramp-get-connection-property vec "config-check-data")))
+ (config-check
+ (and config-check-function
+ ;; If we are in `make-process', we don't need to recompute.
+ (if (and old-config-check
+ (tramp-get-connection-property vec "process-name"))
+ old-config-check
+ (tramp-set-connection-property
+ vec "config-check-data"
+ (tramp-compat-funcall config-check-function vec))))))
+ (when (and (stringp old-uname) (stringp uname)
+ (not (string-equal old-uname uname)))
(tramp-message
vec 3
"Connection reset, because remote host changed from `%s' to `%s'"
@@ -4487,6 +4506,15 @@ process to set up. VEC specifies the connection."
;; We want to keep the password.
(tramp-cleanup-connection vec t t)
(throw 'uname-changed (tramp-maybe-open-connection vec)))
+ (when (and (stringp old-config-check) (stringp config-check)
+ (not (string-equal old-config-check config-check)))
+ (tramp-message
+ vec 3
+ "Connection reset, because remote configuration changed from `%s' to
`%s'"
+ old-config-check config-check)
+ ;; We want to keep the password.
+ (tramp-cleanup-connection vec t t)
+ (throw 'uname-changed (tramp-maybe-open-connection vec)))
;; Try to set up the coding system correctly.
;; CCC this can't be the right way to do it. Hm.
diff --git a/lisp/net/tramp-sudoedit.el b/lisp/net/tramp-sudoedit.el
index dc87c590b3..bc8739c4d6 100644
--- a/lisp/net/tramp-sudoedit.el
+++ b/lisp/net/tramp-sudoedit.el
@@ -369,33 +369,36 @@ the result will be a local, non-Tramp, file name."
;; Unless NAME is absolute, concat DIR and NAME.
(unless (file-name-absolute-p name)
(setq name (tramp-compat-file-name-concat dir name)))
- (with-parsed-tramp-file-name name nil
- ;; Tilde expansion if necessary. We cannot accept "~/", because
- ;; under sudo "~/" is expanded to the local user home directory
- ;; but to the root home directory.
- (when (zerop (length localname))
- (setq localname "~"))
- (unless (file-name-absolute-p localname)
- (setq localname (format "~%s/%s" user localname)))
- (when (string-match
- (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl)) eos)
- localname)
- (let ((uname (match-string 1 localname))
- (fname (match-string 2 localname))
- hname)
- (when (zerop (length uname))
- (setq uname user))
- (when (setq hname (tramp-get-home-directory v uname))
- (setq localname (concat hname fname)))))
- ;; Do not keep "/..".
- (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
- (setq localname "/"))
- ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
- (tramp-make-tramp-file-name
- v (if (string-prefix-p "~" localname)
- localname
- (tramp-run-real-handler
- #'expand-file-name (list localname))))))
+ ;; If NAME is not a Tramp file, run the real handler.
+ (if (not (tramp-tramp-file-p name))
+ (tramp-run-real-handler #'expand-file-name (list name))
+ (with-parsed-tramp-file-name name nil
+ ;; Tilde expansion if necessary. We cannot accept "~/", because
+ ;; under sudo "~/" is expanded to the local user home directory
+ ;; but to the root home directory.
+ (when (zerop (length localname))
+ (setq localname "~"))
+ (unless (file-name-absolute-p localname)
+ (setq localname (format "~%s/%s" user localname)))
+ (when (string-match
+ (tramp-compat-rx bos "~" (group (* (not "/"))) (group (* nonl))
eos)
+ localname)
+ (let ((uname (match-string 1 localname))
+ (fname (match-string 2 localname))
+ hname)
+ (when (zerop (length uname))
+ (setq uname user))
+ (when (setq hname (tramp-get-home-directory v uname))
+ (setq localname (concat hname fname)))))
+ ;; Do not keep "/..".
+ (when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
+ (setq localname "/"))
+ ;; Do normal `expand-file-name' (this does "~user/", "/./" and "/../").
+ (tramp-make-tramp-file-name
+ v (if (string-prefix-p "~" localname)
+ localname
+ (tramp-run-real-handler
+ #'expand-file-name (list localname)))))))
(defun tramp-sudoedit-remote-acl-p (vec)
"Check, whether ACL is enabled on the remote host."
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 03dc47a053..e9f30bea7b 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -278,8 +278,16 @@ pair of the form (KEY VALUE). The following KEYs are
defined:
* `tramp-direct-async'
Whether the method supports direct asynchronous processes.
- Until now, just \"ssh\"-based, \"sshfs\"-based and
- \"adb\"-based methods do.
+ Until now, just \"ssh\"-based, \"sshfs\"-based, \"adb\"-based
+ and container methods do. If it is a list of strings, they
+ are used to construct the remote command.
+
+ * `tramp-config-check'
+ A function to be called with one argument, VEC. It should
+ return a string which is used to check, whether the
+ configuration of the remote host has been changed (which
+ would require to flush the cache data). This string is kept
+ as connection property \"config-check-data\".
* `tramp-copy-program'
This specifies the name of the program to use for remotely copying
@@ -1088,34 +1096,18 @@ Derived from `tramp-postfix-host-format'.")
(defun tramp-build-remote-file-name-spec-regexp ()
"Construct a regexp matching a Tramp file name for a Tramp syntax.
It is expected, that `tramp-syntax' has the proper value."
- ;; Starting with Emacs 27, we can use `rx-let'.
- (let* ((user-regexp
- (tramp-compat-rx
- (group-n 6 (regexp tramp-user-regexp))
- (regexp tramp-postfix-user-regexp)))
- (host-regexp
- (tramp-compat-rx
- (group-n 7 (| (regexp tramp-host-regexp)
- (: (regexp tramp-prefix-ipv6-regexp)
- (? (regexp tramp-ipv6-regexp))
- (regexp tramp-postfix-ipv6-regexp)))
- ;; Optional port.
- (? (regexp tramp-prefix-port-regexp)
- (regexp tramp-port-regexp)))))
- (user-host-regexp
- (if (eq tramp-syntax 'simplified)
- ;; There must be either user or host.
- (tramp-compat-rx
- (| (: (regexp user-regexp) (? (regexp host-regexp)))
- (: (? (regexp user-regexp)) (regexp host-regexp))))
- (tramp-compat-rx
- (? (regexp user-regexp)) (? (regexp host-regexp))))))
- (tramp-compat-rx
- ;; Method.
- (group-n 5 (regexp tramp-method-regexp))
- (regexp tramp-postfix-method-regexp)
- ;; User and host.
- (regexp user-host-regexp))))
+ (tramp-compat-rx
+ ;; Method.
+ (group (regexp tramp-method-regexp)) (regexp tramp-postfix-method-regexp)
+ ;; Optional user. This includes domain.
+ (? (group (regexp tramp-user-regexp)) (regexp tramp-postfix-user-regexp))
+ ;; Optional host.
+ (? (group (| (regexp tramp-host-regexp)
+ (: (regexp tramp-prefix-ipv6-regexp)
+ (? (regexp tramp-ipv6-regexp))
+ (regexp tramp-postfix-ipv6-regexp)))
+ ;; Optional port.
+ (? (regexp tramp-prefix-port-regexp) (regexp tramp-port-regexp))))))
(defvar tramp-remote-file-name-spec-regexp
nil ; Initialized when defining `tramp-syntax'!
@@ -1214,7 +1206,8 @@ The `ftp' syntax does not support methods.")
;; "/ssh:host:~/path" becomes "c:/ssh:host:~/path". See also
;; `tramp-drop-volume-letter'.
(? (regexp tramp-volume-letter-regexp))
- (regexp tramp-prefix-regexp)
+ ;; We cannot use `tramp-prefix-regexp', because it starts with `bol'.
+ (literal tramp-prefix-format)
;; Optional multi hops.
(* (regexp tramp-remote-file-name-spec-regexp)
@@ -1541,7 +1534,8 @@ same connection. Make a copy in order to avoid side
effects."
;; Comparison of file names is performed by `tramp-equal-remote'.
(defun tramp-file-name-equal-p (vec1 vec2)
- "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'."
+ "Check, whether VEC1 and VEC2 denote the same `tramp-file-name'.
+LOCALNAME and HOP do not count."
(and (tramp-file-name-p vec1) (tramp-file-name-p vec2)
(equal (tramp-file-name-unify vec1)
(tramp-file-name-unify vec2))))
@@ -1862,7 +1856,8 @@ the form (METHOD USER DOMAIN HOST PORT LOCALNAME
&optional HOP)."
tramp-prefix-regexp ""
(replace-regexp-in-string
(tramp-compat-rx
- (regexp tramp-postfix-host-regexp) eos) tramp-postfix-hop-format
+ (regexp tramp-postfix-host-regexp) eos)
+ tramp-postfix-hop-format
(tramp-make-tramp-file-name vec 'noloc)))))
(defun tramp-completion-make-tramp-file-name (method user host localname)
@@ -4003,6 +3998,17 @@ Let-bind it when necessary.")
(cond
((not (file-exists-p file1)) nil)
((not (file-exists-p file2)) t)
+ ;; Tramp reads and writes timestamps on second level. So we round
+ ;; the timestamps to seconds w/o fractions.
+ ;; `time-convert' has been introduced with Emacs 27.1.
+ ((fboundp 'time-convert)
+ (time-less-p
+ (tramp-compat-funcall
+ 'time-convert
+ (file-attribute-modification-time (file-attributes file2)) 'integer)
+ (tramp-compat-funcall
+ 'time-convert
+ (file-attribute-modification-time (file-attributes file1)) 'integer)))
(t (time-less-p
(file-attribute-modification-time (file-attributes file2))
(file-attribute-modification-time (file-attributes file1))))))
@@ -4579,14 +4585,9 @@ Do not set it manually, it is used buffer-local in
`tramp-get-lock-pid'.")
(setq file (concat file ".elc")))
((file-exists-p (concat file ".el"))
(setq file (concat file ".el")))))
- (when must-suffix
- ;; The first condition is always true for absolute file names.
- ;; Included for safety's sake.
- (unless (or (file-name-directory file)
- (string-match-p (rx ".el" (? "c") eos) file))
- (tramp-error
- v 'file-error
- "File `%s' does not include a `.el' or `.elc' suffix" file)))
+ (when (and must-suffix (not (string-match-p (rx ".el" (? "c") eos) file)))
+ (tramp-error
+ v 'file-error "File `%s' does not include a `.el' or `.elc' suffix"
file))
(unless (or noerror (file-exists-p file))
(tramp-error v 'file-missing file))
(if (not (file-exists-p file))
@@ -4804,7 +4805,14 @@ substitution. SPEC-LIST is a list of char/value pairs
used for
(command
(append
`("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env")
- env `(,command ")"))))
+ env `(,command ")")))
+ ;; Add remote shell if needed.
+ (command
+ (if (consp (tramp-get-method-parameter v 'tramp-direct-async))
+ (append
+ (tramp-get-method-parameter v 'tramp-direct-async)
+ `(,(mapconcat #'identity command " ")))
+ command)))
;; Check for `tramp-sh-file-name-handler', because something
;; is different between tramp-sh.el, and tramp-adb.el or
diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el
index 2b39add20d..caf6750c26 100644
--- a/lisp/net/trampver.el
+++ b/lisp/net/trampver.el
@@ -83,7 +83,7 @@
(unless (string-equal "ok" x) (error "%s" x)))
(defun tramp-inside-emacs ()
- "Version string provided by INSIDE_EMACS enmvironment variable."
+ "Version string provided by INSIDE_EMACS environment variable."
(concat (or (getenv "INSIDE_EMACS") emacs-version)
",tramp:" tramp-version))
diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el
index dfe5c369e2..fb8d5322c0 100644
--- a/lisp/nxml/nxml-mode.el
+++ b/lisp/nxml/nxml-mode.el
@@ -195,7 +195,7 @@ This is not used directly, but only via inheritance by
other faces."
(defface nxml-char-ref-number
'((t (:inherit nxml-ref)))
"Face used for the number in character references.
-This includes ths `x' in hex references."
+This includes the `x' in hex references."
:group 'nxml-faces)
(defface nxml-char-ref-delimiter
@@ -536,8 +536,7 @@ Many aspects this mode can be customized using
(save-restriction
(widen)
(with-silent-modifications
- (nxml-with-invisible-motion
- (nxml-scan-prolog)))))
+ (nxml-scan-prolog))))
(setq-local syntax-ppss-table sgml-tag-syntax-table)
(setq-local syntax-propertize-function #'nxml-syntax-propertize)
(add-function :filter-return (local 'filter-buffer-substring-function)
@@ -584,8 +583,7 @@ Many aspects this mode can be customized using
(save-excursion
(widen)
(with-silent-modifications
- (nxml-with-invisible-motion
- (remove-text-properties (point-min) (point-max) '(face nil)))))
+ (remove-text-properties (point-min) (point-max) '(face nil))))
(remove-hook 'change-major-mode-hook #'nxml-cleanup t))
(defun nxml-degrade (context err)
diff --git a/lisp/nxml/nxml-util.el b/lisp/nxml/nxml-util.el
index 662d43842e..241c54488f 100644
--- a/lisp/nxml/nxml-util.el
+++ b/lisp/nxml/nxml-util.el
@@ -65,12 +65,6 @@ This is the inverse of `nxml-make-namespace'."
(nxml-degrade ,context ,error-symbol))))
`(progn ,@body)))
-(defmacro nxml-with-invisible-motion (&rest body)
- "Evaluate body without calling any point motion hooks."
- (declare (indent 0) (debug t))
- `(let ((inhibit-point-motion-hooks t))
- ,@body))
-
(defun nxml-display-file-parse-error (err)
(let* ((filename (nth 1 err))
(buffer (find-file-noselect filename))
diff --git a/lisp/nxml/rng-cmpct.el b/lisp/nxml/rng-cmpct.el
index 453c2b736d..85db33b9a9 100644
--- a/lisp/nxml/rng-cmpct.el
+++ b/lisp/nxml/rng-cmpct.el
@@ -1,6 +1,6 @@
;;; rng-cmpct.el --- parsing of RELAX NG Compact Syntax schemas -*-
lexical-binding:t -*-
-;; Copyright (C) 2003, 2007-2022 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2022 Free Software Foundation, Inc.
;; Author: James Clark
;; Keywords: wp, hypermedia, languages, XML, RelaxNG
@@ -82,19 +82,17 @@ Return a pattern."
(concat "\\`\\(" (regexp-opt rng-c-keywords) "\\)\\'")
"Regular expression to match a keyword in the compact syntax.")
-(defvar rng-c-syntax-table nil
+(defvar rng-c-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?# "<" st)
+ (modify-syntax-entry ?\n ">" st)
+ (modify-syntax-entry ?- "w" st)
+ (modify-syntax-entry ?. "w" st)
+ (modify-syntax-entry ?_ "w" st)
+ (modify-syntax-entry ?: "_" st)
+ st)
"Syntax table for parsing the compact syntax.")
-(if rng-c-syntax-table
- ()
- (setq rng-c-syntax-table (make-syntax-table))
- (modify-syntax-entry ?# "<" rng-c-syntax-table)
- (modify-syntax-entry ?\n ">" rng-c-syntax-table)
- (modify-syntax-entry ?- "w" rng-c-syntax-table)
- (modify-syntax-entry ?. "w" rng-c-syntax-table)
- (modify-syntax-entry ?_ "w" rng-c-syntax-table)
- (modify-syntax-entry ?: "_" rng-c-syntax-table))
-
(defconst rng-c-literal-1-re
"'\\(''\\([^']\\|'[^']\\|''[^']\\)*''\\|[^'\n]*\\)'"
"Regular expression to match a single-quoted literal.")
diff --git a/lisp/nxml/rng-nxml.el b/lisp/nxml/rng-nxml.el
index ccbf4d8de2..b1beb19503 100644
--- a/lisp/nxml/rng-nxml.el
+++ b/lisp/nxml/rng-nxml.el
@@ -366,45 +366,44 @@ set `xmltok-dtd'. Returns the position of the end of the
token."
(save-excursion
(save-restriction
(widen)
- (nxml-with-invisible-motion
- (if (= pos (point-min))
- (rng-set-initial-state)
- (let ((state (get-text-property (1- pos) 'rng-state)))
- (cond (state
- (rng-restore-state state)
- (goto-char pos))
- (t
- (let ((start (previous-single-property-change pos
- 'rng-state)))
- (cond (start
- (rng-restore-state (get-text-property (1- start)
- 'rng-state))
- (goto-char start))
- (t (rng-set-initial-state))))))))
- (xmltok-save
- (if (= (point) 1)
- (xmltok-forward-prolog)
- (setq xmltok-dtd rng-dtd))
- (cond ((and (< pos (point))
- ;; This handles the case where the prolog ends
- ;; with a < without any following name-start
- ;; character. This will be treated by the parser
- ;; as part of the prolog, but we want to treat
- ;; it as the start of the instance.
- (eq (char-after pos) ?<)
- (<= (point)
- (save-excursion
- (goto-char (1+ pos))
- (skip-chars-forward " \t\r\n")
- (point))))
- pos)
- ((< (point) pos)
- (let ((rng-dt-namespace-context-getter
- '(nxml-ns-get-context))
- (rng-parsing-for-state t))
- (rng-forward pos))
- (point))
- (t pos)))))))
+ (if (= pos (point-min))
+ (rng-set-initial-state)
+ (let ((state (get-text-property (1- pos) 'rng-state)))
+ (cond (state
+ (rng-restore-state state)
+ (goto-char pos))
+ (t
+ (let ((start (previous-single-property-change pos
+ 'rng-state)))
+ (cond (start
+ (rng-restore-state (get-text-property (1- start)
+ 'rng-state))
+ (goto-char start))
+ (t (rng-set-initial-state))))))))
+ (xmltok-save
+ (if (= (point) 1)
+ (xmltok-forward-prolog)
+ (setq xmltok-dtd rng-dtd))
+ (cond ((and (< pos (point))
+ ;; This handles the case where the prolog ends
+ ;; with a < without any following name-start
+ ;; character. This will be treated by the parser
+ ;; as part of the prolog, but we want to treat
+ ;; it as the start of the instance.
+ (eq (char-after pos) ?<)
+ (<= (point)
+ (save-excursion
+ (goto-char (1+ pos))
+ (skip-chars-forward " \t\r\n")
+ (point))))
+ pos)
+ ((< (point) pos)
+ (let ((rng-dt-namespace-context-getter
+ '(nxml-ns-get-context))
+ (rng-parsing-for-state t))
+ (rng-forward pos))
+ (point))
+ (t pos))))))
(defun rng-adjust-state-for-attribute (lt-pos start)
(xmltok-save
diff --git a/lisp/nxml/rng-uri.el b/lisp/nxml/rng-uri.el
index 77fed8c32d..59e696e2cc 100644
--- a/lisp/nxml/rng-uri.el
+++ b/lisp/nxml/rng-uri.el
@@ -68,7 +68,7 @@ Signal an error if URI is not a valid file URL."
;; pattern is either nil or match or replace
(defun rng-uri-file-name-1 (uri pattern)
- (unless (string-match "\\`\\(?:[^%]\\|%[[:xdigit:]]{2}\\)*\\'" uri)
+ (unless (string-match "\\`\\(?:[^%]\\|%[[:xdigit:]]\\{2\\}\\)*\\'" uri)
(rng-uri-error "Bad escapes in URI `%s'" uri))
(setq uri (rng-uri-unescape-multibyte uri))
(let* ((components
@@ -312,7 +312,7 @@ Both FULL and BASE must be absolute URIs."
(defun rng-uri-unescape-unibyte (str)
(replace-regexp-in-string "%[0-7][[:xdigit:]]"
(lambda (h)
- (string-to-number (substring h 1) 16))
+ (string (string-to-number (substring h 1) 16)))
str
t
t))
@@ -325,8 +325,8 @@ Both FULL and BASE must be absolute URIs."
(regexp-quote
(if (= (length match) 1)
match
- (string-to-number (substring match 1)
- 16)))))
+ (string (string-to-number (substring match 1)
+ 16))))))
str
t
t))
diff --git a/lisp/nxml/rng-valid.el b/lisp/nxml/rng-valid.el
index ad5c9c7a15..d82c8470d7 100644
--- a/lisp/nxml/rng-valid.el
+++ b/lisp/nxml/rng-valid.el
@@ -441,25 +441,24 @@ The schema is set like `rng-auto-set-schema'."
(save-excursion
(save-restriction
(widen)
- (nxml-with-invisible-motion
- (condition-case-unless-debug err
- (and (rng-validate-prepare)
- (let ((rng-dt-namespace-context-getter '(nxml-ns-get-context)))
- (with-silent-modifications
- (rng-do-some-validation-1 continue-p-function))))
- ;; errors signaled from a function run by an idle timer
- ;; are ignored; if we don't catch them, validation
- ;; will get mysteriously stuck at a single place
- (rng-compile-error
- (message "Incorrect schema. %s" (nth 1 err))
- (rng-validate-mode 0)
- nil)
- (error
- (message "Internal error in rng-validate-mode triggered at buffer
position %d. %s"
- (point)
- (error-message-string err))
- (rng-validate-mode 0)
- nil))))))
+ (condition-case-unless-debug err
+ (and (rng-validate-prepare)
+ (let ((rng-dt-namespace-context-getter '(nxml-ns-get-context)))
+ (with-silent-modifications
+ (rng-do-some-validation-1 continue-p-function))))
+ ;; errors signaled from a function run by an idle timer
+ ;; are ignored; if we don't catch them, validation
+ ;; will get mysteriously stuck at a single place
+ (rng-compile-error
+ (message "Incorrect schema. %s" (nth 1 err))
+ (rng-validate-mode 0)
+ nil)
+ (error
+ (message "Internal error in rng-validate-mode triggered at buffer
position %d. %s"
+ (point)
+ (error-message-string err))
+ (rng-validate-mode 0)
+ nil)))))
(defun rng-validate-prepare ()
"Prepare to do some validation, initializing point and the state.
diff --git a/lisp/obsolete/linum.el b/lisp/obsolete/linum.el
index c6ce3d6d11..e94cf5086c 100644
--- a/lisp/obsolete/linum.el
+++ b/lisp/obsolete/linum.el
@@ -209,10 +209,7 @@ Linum mode is a buffer-local minor mode."
(overlay-put ov 'before-string
(propertize " " 'display `((margin left-margin)
,str)))
(overlay-put ov 'linum-str str))))
- ;; Text may contain those nasty intangible properties, but that
- ;; shouldn't prevent us from counting those lines.
- (let ((inhibit-point-motion-hooks t))
- (forward-line))
+ (forward-line)
(setq line (1+ line)))
(when (display-graphic-p)
(setq width (ceiling
diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el
index 91baa4d28e..afc6284b34 100644
--- a/lisp/obsolete/vi.el
+++ b/lisp/obsolete/vi.el
@@ -927,13 +927,13 @@ it is used instead of the saved one."
(vi-repeat-last-find-char count))
(defun vi-backward-upto-char (count char)
- "Find upto the COUNT'th CHAR backward on current line."
+ "Find up to the COUNT'th CHAR backward on current line."
(interactive "p\nc")
(setq vi-last-find-char (cons -1 (cons char t)))
(vi-repeat-last-find-char count))
(defun vi-forward-upto-char (count char)
- "Find upto the COUNT'th CHAR forward on current line."
+ "Find up to the COUNT'th CHAR forward on current line."
(interactive "p\nc")
(setq vi-last-find-char (cons 1 (cons char t)))
(vi-repeat-last-find-char count))
diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1
index 836e1430df..1491a4645a 100644
--- a/lisp/org/ChangeLog.1
+++ b/lisp/org/ChangeLog.1
@@ -881,7 +881,7 @@
(org-table-find-dataline, org-table-move-row)
(org-table-insert-hline, org-table-kill-row):
Use `org-move-to-column' with the IGNORE-INVISIBLE arg set to `t', so
- that abbreviated rows don't interfer with setting the cursor back
+ that abbreviated rows don't interfere with setting the cursor back
at the correct position.
* org.el (org-agenda-prepare-buffers): Use `save-excursion'
@@ -4724,7 +4724,7 @@
2013-11-12 Michael Brand <michael.ch.brand@gmail.com>
* org-table.el (org-table-eval-formula): Align the arrow pointing
- to the error in a Calc formula to the other fomula debugger logs.
+ to the error in a Calc formula to the other formula debugger logs.
* org.el (org-link-escape-chars-browser): Add char double quote.
(org-open-at-point): Use the constant
@@ -10556,7 +10556,7 @@
* org-element.el (org-element-paragraph-separate): Fix comments in
paragraph separator regexp. Optimize it.
- * org-element.el: Update code commets.
+ * org-element.el: Update code comments.
* org.el (org-mark-subtree): Fix bug when marking subtree with
point on an inlinetask. Refactor code.
@@ -13798,7 +13798,7 @@
2012-01-03 Dave Abrahams <dave@boostpro.com>
* org-agenda.el (org-agenda-follow-indirect): New option.
- (org-agenda-follow-mode): Call `org-agenda-do-context-action' fro
+ (org-agenda-follow-mode): Call `org-agenda-do-context-action' from
follow mode.
(org-agenda-do-context-action): Also do indirect follow mode
action.
@@ -17948,7 +17948,7 @@
* org.el (org-narrow-to-subtree): Ensure `org-back-to-heading'
will move point to a real heading and not an inline task by
- wraping function into a `org-with-limited-levels' macro.
+ wrapping function into a `org-with-limited-levels' macro.
2011-07-28 Bastien Guerry <bzg@gnu.org>
@@ -20112,10 +20112,10 @@
2011-05-10 Jim Meyering <meyering@redhat.com>
Fix doubled-word typos.
- * org-agenda.el (org-agenda-entry-types): the the -> the
- * org-table.el (org-table-get-remote-range): or or -> or
- * org-wl.el (org-wl-folder-type): the the -> the
- * org.el (org-goto, org-inside-LaTeX-fragment-p): Likewise.
+ * org-agenda.el (org-agenda-entry-types):
+ * org-table.el (org-table-get-remote-range):
+ * org-wl.el (org-wl-folder-type):
+ * org.el (org-goto, org-inside-LaTeX-fragment-p): Fix typos.
2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca>
@@ -24341,7 +24341,7 @@
2010-07-19 Bernt Hansen <bernt@norang.ca>
* org.el (org-time-string-to-absolute): Ignore cyclic repeater
- when displaying items on todays agenda date.
+ when displaying items on today's agenda date.
2010-07-19 Carsten Dominik <carsten.dominik@gmail.com>
@@ -28477,7 +28477,7 @@
(outline-end-of-subtree): Make `outline-end-of-subtree' use the
org-version of this function in Org-mode. We use advice to
implement this change, so that future changes to this function in
- outline.el wil be handled properly.
+ outline.el will be handled properly.
(org-forward-same-level, org-backward-same-level): New commands.
2009-08-06 Carsten Dominik <carsten.dominik@gmail.com>
@@ -28769,7 +28769,7 @@
attachments.
* org-latex.el (org-export-latex-quotation-marks): Fix export of
- quotation makrs in parenthesis.
+ quotation marks in parenthesis.
(org-remove-initial-hash): New function.
(org-export-latex-preprocess): Fix bug with infinite loop if
environment is not properly closed.
@@ -30559,7 +30559,7 @@
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
* org-archive.el (org-extract-archive-heading): Allow %s for file
- name also in achive location heading.
+ name also in archive location heading.
2009-01-25 Carsten Dominik <carsten.dominik@gmail.com>
@@ -30650,7 +30650,7 @@
and scheduling search.
* org-exp.el (org-html-handle-time-stamps): No longer check for
- the `org-export-with-timestamps' option, because the preprocesser
+ the `org-export-with-timestamps' option, because the preprocessor
has taken care of this already.
* org.el (org-entry-properties): Catch the case when this is
@@ -32411,7 +32411,7 @@
* org-exp.el (org-print-icalendar-entries): Move the call to
`org-diary-to-ical-string' out of the loop, and kill the buffer
- afterwords.
+ afterwards.
* org-remember.el (org-remember-visit-immediately):
Position cursor after moving to the note.
diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el
index cd822ef837..93d1d34229 100644
--- a/lisp/org/ob-R.el
+++ b/lisp/org/ob-R.el
@@ -545,7 +545,7 @@ by `org-babel-comint-async-filter'."
(defun ob-session-async-R-value-callback (params tmp-file)
"Callback for async value results.
-Assigned locally to `ob-session-async-file-callback' in R
+Assigned locally to `org-babel-comint-async-file-callback' in R
comint buffers used for asynchronous Babel evaluation."
(let* ((graphics-file (and (member "graphics" (assq :result-params params))
(org-babel-graphical-output-file params)))
diff --git a/lisp/org/ob-matlab.el b/lisp/org/ob-matlab.el
index 4ee090e4ac..f50da0ea43 100644
--- a/lisp/org/ob-matlab.el
+++ b/lisp/org/ob-matlab.el
@@ -32,7 +32,7 @@
;; matlab.el required for interactive emacs sessions and matlab-mode
;; major mode for source code editing buffer
-;; http://matlab-emacs.sourceforge.net/
+;; https://matlab-emacs.sourceforge.net/
;;; Code:
(require 'ob)
diff --git a/lisp/org/ob-plantuml.el b/lisp/org/ob-plantuml.el
index ced00fbdda..7a495e8e7f 100644
--- a/lisp/org/ob-plantuml.el
+++ b/lisp/org/ob-plantuml.el
@@ -30,7 +30,7 @@
;;; Requirements:
-;; plantuml | http://plantuml.sourceforge.net/
+;; plantuml | https://plantuml.com/
;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file (when
exec mode is `jar')
;;; Code:
diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el
index 525d27bc07..d9814a7aa6 100644
--- a/lisp/org/ob-tangle.el
+++ b/lisp/org/ob-tangle.el
@@ -433,7 +433,7 @@ non-nil, return the full association list to be used by
;; The created link is transient. Using ID is
;; not necessary, but could have side-effects if
;; used. An ID property may be added to
- ;; existing entries thus creatin unexpected file
+ ;; existing entries thus creating unexpected file
;; modifications.
(org-id-link-to-org-use-id nil)
(l (org-no-properties (org-store-link nil))))
@@ -525,7 +525,7 @@ by `org-babel-get-src-block-info'."
("link" . ,(let (;; The created link is transient.
Using ID is
;; not necessary, but could have
side-effects if
;; used. An ID property may be added
to
- ;; existing entries thus creatin
unexpected file
+ ;; existing entries thus creating
unexpected file
;; modifications.
(org-id-link-to-org-use-id nil))
(org-no-properties (org-store-link nil))))
diff --git a/lisp/org/ol.el b/lisp/org/ol.el
index 4ad1f6d345..108f031cde 100644
--- a/lisp/org/ol.el
+++ b/lisp/org/ol.el
@@ -339,7 +339,7 @@ another window."
(defcustom org-link-search-must-match-exact-headline 'query-to-create
"Non-nil means internal fuzzy links can only match headlines.
-When nil, the a fuzzy link may point to a target or a named
+When nil, the fuzzy link may point to a target or a named
construct in the document. When set to the special value
`query-to-create', offer to create a new headline when none
matched.
diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el
index 35f19cf03b..e43950f13a 100644
--- a/lisp/org/org-agenda.el
+++ b/lisp/org/org-agenda.el
@@ -5306,7 +5306,7 @@ of what a project is and how to check if it stuck,
customize the variable
"Hook run when the fancy diary buffer is cleaned up.")
(defun org-agenda-cleanup-fancy-diary ()
- "Remove unwanted stuff in buffer created by `fancy-diary-display'.
+ "Remove unwanted stuff in buffer created by `diary-fancy-display'.
This gets rid of the date, the underline under the date, and the
dummy entry installed by Org mode to ensure non-empty diary for
each date. It also removes lines that contain only whitespace."
diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el
index 38e0826075..42de0a0cf9 100644
--- a/lisp/org/org-clock.el
+++ b/lisp/org/org-clock.el
@@ -428,8 +428,7 @@ When `org-clock-clocked-in-display' is set to `frame-title'
or `both', clocking in will replace `frame-title-format' with
this value. Clocking out will restore `frame-title-format'.
-`org-frame-title-string' is a format string using the same
-specifications than `frame-title-format', which see."
+This uses the same format as `frame-title-format', which see."
:version "24.1"
:group 'org-clock
:type 'sexp)
diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el
index 6fc97ca399..b1ee32ab33 100644
--- a/lisp/org/org-ctags.el
+++ b/lisp/org/org-ctags.el
@@ -45,9 +45,7 @@
;; Installation
;; ============
;;
-;; Install org mode
-;; Ensure org-ctags.el is somewhere in your emacs load path.
-;; Download and install Exuberant ctags -- "http://ctags.sourceforge.net/";
+;; Download and install Exuberant ctags -- "https://ctags.sourceforge.net/";
;; Edit your .emacs file (see next section) and load emacs.
;; To put in your init file (.emacs):
diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el
index 4c018062af..474a93577a 100644
--- a/lisp/org/org-element.el
+++ b/lisp/org/org-element.el
@@ -139,7 +139,7 @@ is not sufficient to know if point is at a paragraph
ending. See
(defvar org-element--object-regexp nil
"Regexp possibly matching the beginning of an object.
This regexp allows false positives. Dedicated parser (e.g.,
-`org-export-bold-parser') will take care of further filtering.
+`org-element-bold-parser') will take care of further filtering.
Radio links are not matched by this regexp, as they are treated
specially in `org-element--object-lex'.")
diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el
index d96898372f..78148a1b6d 100644
--- a/lisp/org/org-faces.el
+++ b/lisp/org/org-faces.el
@@ -137,7 +137,7 @@ The following faces apply, with this priority.
Since column view works by putting overlays with a display property
over individual characters in the buffer, the face of the underlining
-character (this might for example be the a TODO keyword) might still
+character (this might for example be the TODO keyword) might still
shine through in some properties. So when your column view looks
funny, with \"random\" colors, weight, strike-through, try to explicitly
set the properties in the `org-column' face. For example, set
diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el
index 7334050b8b..2fb299d5e8 100644
--- a/lisp/org/org-id.el
+++ b/lisp/org/org-id.el
@@ -591,7 +591,7 @@ If SILENT is non-nil, messages are suppressed."
(setf (car item) (expand-file-name (car item) loc))))
org-id-locations)))
(error
- (message "Could not read `org-id-values' from %s, setting it to nil"
+ (message "Could not read `org-id-locations' from %s, setting it to
nil"
org-id-locations-file))))
(setq org-id-files (mapcar 'car org-id-locations))
(setq org-id-locations (org-id-alist-to-hash org-id-locations))))
diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el
index 7c4de03bc2..cd99f30e7b 100644
--- a/lisp/org/org-protocol.el
+++ b/lisp/org/org-protocol.el
@@ -42,7 +42,6 @@
;;
;; 1.) Add this to your init file (.emacs probably):
;;
-;; (add-to-list 'load-path "/path/to/org-protocol/")
;; (require 'org-protocol)
;;
;; 3.) Ensure emacs-server is up and running.
@@ -66,7 +65,7 @@
;;
;;
;; As of March 2009 Firefox users follow the steps documented on
-;; http://kb.mozillazine.org/Register_protocol, Opera setup is described here:
+;; https://kb.mozillazine.org/Register_protocol, Opera setup is described here:
;; http://www.opera.com/support/kb/view/535/
;;
;;
@@ -688,7 +687,7 @@ to deal with new-style links.")
fname)))
(defadvice server-visit-files (before org-protocol-detect-protocol-server
activate)
- "Advice server-visit-flist to call
`org-protocol-modify-filename-for-protocol'."
+ "Advice server-visit-flist to call
`org-protocol-check-filename-for-protocol'."
(let ((flist (if org-protocol-reverse-list-of-files
(reverse (ad-get-arg 0))
(ad-get-arg 0)))
diff --git a/lisp/org/org.el b/lisp/org/org.el
index 6f92cdeab5..7de907590e 100644
--- a/lisp/org/org.el
+++ b/lisp/org/org.el
@@ -5929,10 +5929,7 @@ If TAG is a number, get the corresponding match group."
(defun org-unfontify-region (beg end &optional _maybe_loudly)
"Remove fontification and activation overlays from links."
(font-lock-default-unfontify-region beg end)
- (let* ((buffer-undo-list t)
- (inhibit-read-only t) (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t)
- deactivate-mark buffer-file-name buffer-file-truename)
+ (with-silent-modifications
(decompose-region beg end)
(remove-text-properties beg end
'(mouse-face t keymap t org-linked-text t
@@ -16702,10 +16699,9 @@ buffer boundaries with possible narrowing."
(defun org-display-inline-remove-overlay (ov after _beg _end &optional _len)
"Remove inline-display overlay if a corresponding region is modified."
- (let ((inhibit-modification-hooks t))
- (when (and ov after)
- (delete ov org-inline-image-overlays)
- (delete-overlay ov))))
+ (when (and ov after)
+ (delete ov org-inline-image-overlays)
+ (delete-overlay ov)))
(defun org-remove-inline-images ()
"Remove inline display of images."
diff --git a/lisp/org/ox-ascii.el b/lisp/org/ox-ascii.el
index 76a1a71fab..1452f36c11 100644
--- a/lisp/org/ox-ascii.el
+++ b/lisp/org/ox-ascii.el
@@ -456,7 +456,7 @@ Optional argument JUSTIFY can specify any type of
justification
among `left', `center', `right' or `full'. A nil value is
equivalent to `left'. For a justification that doesn't also fill
string, see `org-ascii--justify-lines' and
-`org-ascii--justify-block'.
+`org-ascii--justify-element'.
Return nil if S isn't a string."
(when (stringp s)
diff --git a/lisp/org/ox-koma-letter.el b/lisp/org/ox-koma-letter.el
index 5f62cd1c04..6b5edd20f5 100644
--- a/lisp/org/ox-koma-letter.el
+++ b/lisp/org/ox-koma-letter.el
@@ -35,7 +35,7 @@
;; `org-koma-letter-export-to-pdf' ("pdf" file).
;;
;; On top of buffer keywords supported by `latex' back-end (see
-;; `org-latex-options-alist'), this back-end introduces the following
+;; `org-latex-packages-alist'), this back-end introduces the following
;; keywords:
;; - CLOSING: see `org-koma-letter-closing',
;; - FROM_ADDRESS: see `org-koma-letter-from-address',
@@ -66,7 +66,7 @@
;; - from-logo (see `org-koma-letter-use-from-logo')
;; - email (see `org-koma-letter-use-email')
;; - place (see `org-koma-letter-use-place')
-;; - location (see `org-koma-letter-use-location')
+;; - location (see `org-koma-letter-location')
;; - subject, a list of format options
;; (see `org-koma-letter-subject-format')
;; - after-closing-order, a list of the ordering of headings with
diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el
index 7f2e8ba47f..8c8c80136a 100644
--- a/lisp/org/ox-odt.el
+++ b/lisp/org/ox-odt.el
@@ -3227,8 +3227,7 @@ Return a cons of (TABLE-CELL-STYLE-NAME .
PARAGRAPH-STYLE-NAME).
When STYLE-SPEC is nil, style the table cell the conventional way
- choose cell borders based on row and column groupings and
choose paragraph alignment based on `org-col-cookies' text
-property. See also
-`org-odt-get-paragraph-style-cookie-for-table-cell'.
+property. See also `org-odt-table-style-spec'.
When STYLE-SPEC is non-nil, ignore the above cookie and return
styles congruent with the ODF-1.2 specification."
@@ -3573,8 +3572,7 @@ pertaining to indentation here."
;; item, but also within description lists and low-level
;; headlines.
- ;; See `org-odt-translate-description-lists' and
- ;; `org-odt-translate-low-level-headlines' for how this is
+ ;; See `org-odt--translate-description-lists' for how this is
;; tackled.
(concat "\n"
diff --git a/lisp/org/ox.el b/lisp/org/ox.el
index 56bb4b74df..ca6b3f2208 100644
--- a/lisp/org/ox.el
+++ b/lisp/org/ox.el
@@ -6291,7 +6291,7 @@ to `:default' encoding. If it fails, return S."
;;
;; Export Stack is viewed through a dedicated major mode
;;`org-export-stack-mode' and tools: `org-export-stack-refresh',
-;;`org-export-stack-delete', `org-export-stack-view' and
+;;`org-export-stack-remove', `org-export-stack-view' and
;;`org-export-stack-clear'.
;;
;; For back-ends, `org-export-add-to-stack' add a new source to stack.
diff --git a/lisp/outline.el b/lisp/outline.el
index 93a9247f61..2465a4963a 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -59,6 +59,18 @@ The recommended way to set this is with a `Local Variables:'
list
in the file it applies to.")
;;;###autoload(put 'outline-heading-end-regexp 'safe-local-variable 'stringp)
+(defvar outline-search-function nil
+ "Function to search the next outline heading.
+The function is called with four optional arguments: BOUND, MOVE, BACKWARD,
+LOOKING-AT. The first two arguments BOUND and MOVE are almost the same as
+the BOUND and NOERROR arguments of `re-search-forward', with the difference
+that MOVE accepts only a boolean, either nil or non-nil. When the argument
+BACKWARD is non-nil, the search should search backward like
+`re-search-backward' does. In case of a successful search, the
+function should return non-nil, move point, and set match-data
+appropriately. When the argument LOOKING-AT is non-nil, it should
+imitate the function `looking-at'.")
+
(defvar outline-mode-prefix-map
(let ((map (make-sparse-keymap)))
(define-key map "@" 'outline-mark-subtree)
@@ -233,7 +245,8 @@ This option is only in effect when
`outline-minor-mode-cycle' is non-nil."
(defvar outline-font-lock-keywords
'(
;; Highlight headings according to the level.
- (eval . (list (concat "^\\(?:" outline-regexp "\\).*")
+ (eval . (list (or outline-search-function
+ (concat "^\\(?:" outline-regexp "\\).*"))
0 '(if outline-minor-mode
(if outline-minor-mode-highlight
(list 'face (outline-font-lock-face)))
@@ -281,37 +294,30 @@ This option is only in effect when
`outline-minor-mode-cycle' is non-nil."
[outline-1 outline-2 outline-3 outline-4
outline-5 outline-6 outline-7 outline-8])
-(defcustom outline-minor-mode-use-buttons '(derived-mode . help-mode)
+(defcustom outline-minor-mode-use-buttons nil
"Whether to display clickable buttons on the headings.
-The value should be a `buffer-match-p' condition.
-
These buttons can be used to hide and show the body under the heading.
-Note that this feature is not meant to be used in editing
-buffers (yet) -- that will be amended in a future version."
- :type 'buffer-predicate
- :safe #'booleanp
+When the value is `insert', additional placeholders for buttons are
+inserted to the buffer, so buttons are not only clickable,
+but also typing `RET' on them can hide and show the body.
+When the value is `in-margins', then clickable buttons are
+displayed in the margins before the headings.
+When the value is `t', clickable buttons are displayed
+in the buffer before the headings. The values `t' and
+`in-margins' can be used in editing buffers because they
+don't modify the buffer."
+ :type '(choice (const :tag "Do not use outline buttons" nil)
+ (const :tag "Show outline buttons in margins" in-margins)
+ (const :tag "Show outline buttons in buffer" t))
+ :safe #'symbolp
:version "29.1")
-(defvar-local outline--use-buttons nil
- "Non-nil when buffer displays clickable buttons on the headings.")
+(defvar-local outline--button-icons nil
+ "A list of pre-computed button icons.")
(defvar-local outline--use-rtl nil
"Non-nil when direction of clickable buttons is right-to-left.")
-(defcustom outline-minor-mode-use-margins '(and (derived-mode . special-mode)
- (not (derived-mode .
help-mode)))
- "Whether to display clickable buttons in the margins.
-The value should be a `buffer-match-p' condition.
-
-These buttons can be used to hide and show the body under the heading.
-Note that this feature is meant to be used in editing buffers."
- :type 'buffer-predicate
- :safe #'booleanp
- :version "29.1")
-
-(defvar-local outline--use-margins nil
- "Non-nil when buffer displays clickable buttons in the margins.")
-
(define-icon outline-open nil
'((image "outline-open.svg" "outline-open.pbm" :height (0.8 . em))
(emoji "🔽")
@@ -339,17 +345,26 @@ Note that this feature is meant to be used in editing
buffers."
:version "29.1")
(define-icon outline-open-in-margins outline-open
- '((image "outline-open.svg" "outline-open.pbm" :height 10))
+ '((image "outline-open.svg" "outline-open.pbm" :height 10)
+ (emoji "🔽")
+ (symbol "▼")
+ (text "v"))
"Icon used for buttons for opened sections in margins."
:version "29.1")
(define-icon outline-close-in-margins outline-close
- '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation -90))
+ '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation -90)
+ (emoji "▶️")
+ (symbol "▶")
+ (text ">"))
"Icon used for buttons for closed sections in margins."
:version "29.1")
(define-icon outline-close-rtl-in-margins outline-close-rtl
- '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation 90))
+ '((image "outline-open.svg" "outline-open.pbm" :height 10 :rotation 90)
+ (emoji "◀️")
+ (symbol "◀")
+ (text "<"))
"Right-to-left icon used for closed sections in margins."
:version "29.1")
@@ -364,7 +379,9 @@ data reflects the `outline-regexp'.")
"Return one of `outline-font-lock-faces' for current level."
(save-excursion
(goto-char (match-beginning 0))
- (looking-at outline-regexp)
+ (if outline-search-function
+ (funcall outline-search-function nil nil nil t)
+ (looking-at outline-regexp))
(aref outline-font-lock-faces
(% (1- (funcall outline-level))
(length outline-font-lock-faces)))))
@@ -452,7 +469,7 @@ bindings, per the current major mode."
(defcustom outline-minor-mode-highlight nil
"Whether to highlight headings in `outline-minor-mode' using font-lock
keywords.
-This option controles whether `outline-minor-mode' will use its font-lock
+This option controls whether `outline-minor-mode' will use its font-lock
keywords to highlight headings, which could potentially conflict with
font-lock faces defined by the major mode. Thus, a non-nil value will
work well only when there's no such conflict.
@@ -472,10 +489,13 @@ outline font-lock faces to those of major mode."
;; Fallback to overlays when font-lock is unsupported.
(save-excursion
(goto-char (point-min))
- (let ((regexp (concat "^\\(?:" outline-regexp "\\).*$")))
- (while (re-search-forward regexp nil t)
+ (let ((regexp (unless outline-search-function
+ (concat "^\\(?:" outline-regexp "\\).*$"))))
+ (while (if outline-search-function
+ (funcall outline-search-function)
+ (re-search-forward regexp nil t))
(let ((overlay (make-overlay (match-beginning 0) (match-end 0))))
- (overlay-put overlay 'outline-overlay t)
+ (overlay-put overlay 'outline-highlight t)
;; FIXME: Is it possible to override all underlying face attributes?
(when (or (memq outline-minor-mode-highlight '(append override))
(and (eq outline-minor-mode-highlight t)
@@ -499,30 +519,22 @@ See the command `outline-mode' for more information on
this mode."
(key-description outline-minor-mode-prefix)
outline-mode-prefix-map)
(if outline-minor-mode
(progn
- (cond
- ((buffer-match-p outline-minor-mode-use-margins (current-buffer))
- (setq-local outline--use-margins t))
- ((buffer-match-p outline-minor-mode-use-buttons (current-buffer))
- (setq-local outline--use-buttons t)))
- (when (and (or outline--use-buttons outline--use-margins)
- (eq (current-bidi-paragraph-direction) 'right-to-left))
- (setq-local outline--use-rtl t))
- (when outline--use-margins
- (if outline--use-rtl
- (setq-local right-margin-width (1+ right-margin-width))
- (setq-local left-margin-width (1+ left-margin-width)))
- (setq-local fringes-outside-margins t)
- ;; Force display of margins
- (set-window-buffer nil (window-buffer)))
- (when (or outline--use-buttons outline--use-margins)
+ (when outline-minor-mode-use-buttons
(add-hook 'after-change-functions
- (lambda (beg end _len)
- (when outline--use-buttons
- (remove-overlays beg end 'outline-button t))
- (when outline--use-margins
- (remove-overlays beg end 'outline-margin t))
- (outline--fix-up-all-buttons beg end))
- nil t))
+ #'outline--fix-buttons-after-change nil t)
+ (when (eq (current-bidi-paragraph-direction) 'right-to-left)
+ (setq-local outline--use-rtl t))
+ (setq-local outline--button-icons (outline--create-button-icons))
+ (when (and (eq outline-minor-mode-use-buttons 'in-margins)
+ (> 1 (if outline--use-rtl right-margin-width
+ left-margin-width)))
+ (if outline--use-rtl
+ (setq-local right-margin-width (1+ right-margin-width))
+ (setq-local left-margin-width (1+ left-margin-width)))
+ (setq-local fringes-outside-margins t)
+ ;; Force display of margins
+ (when (eq (current-buffer) (window-buffer))
+ (set-window-buffer nil (window-buffer)))))
(when outline-minor-mode-highlight
(if (and global-font-lock-mode (font-lock-specified-p major-mode))
(progn
@@ -547,17 +559,19 @@ See the command `outline-mode' for more information on
this mode."
(if font-lock-fontified
(font-lock-remove-keywords nil outline-font-lock-keywords))
(font-lock-flush)
- (remove-overlays nil nil 'outline-overlay t))
- (when outline--use-buttons
- (remove-overlays nil nil 'outline-button t))
- (when outline--use-margins
- (remove-overlays nil nil 'outline-margin t)
- (if outline--use-rtl
- (setq-local right-margin-width (1- right-margin-width))
- (setq-local left-margin-width (1- left-margin-width)))
- (setq-local fringes-outside-margins nil)
- ;; Force removal of margins
- (set-window-buffer nil (window-buffer)))))
+ (remove-overlays nil nil 'outline-highlight t))
+ (when outline-minor-mode-use-buttons
+ (remove-overlays nil nil 'outline-button t)
+ (when (and (eq outline-minor-mode-use-buttons 'in-margins)
+ (< 0 (if outline--use-rtl right-margin-width
+ left-margin-width)))
+ (if outline--use-rtl
+ (setq-local right-margin-width (1- right-margin-width))
+ (setq-local left-margin-width (1- left-margin-width)))
+ (setq-local fringes-outside-margins nil)
+ ;; Force removal of margins
+ (when (eq (current-buffer) (window-buffer))
+ (set-window-buffer nil (window-buffer)))))))
(defvar-local outline-heading-alist ()
"Alist associating a heading for every possible level.
@@ -596,26 +610,37 @@ or else the number of characters matched by
`outline-regexp'."
"Skip forward to just before the next heading line.
If there's no following heading line, stop before the newline
at the end of the buffer."
- (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
- nil 'move)
- (goto-char (match-beginning 0)))
- (if (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
- (forward-char -1)))
+ (when (if outline-search-function
+ (progn
+ ;; Emulate "\n" to force finding the next preface
+ (unless (eobp) (forward-char 1))
+ (funcall outline-search-function nil t))
+ (re-search-forward (concat "\n\\(?:" outline-regexp "\\)")
+ nil 'move))
+ (goto-char (match-beginning 0))
+ ;; Compensate "\n" from the beginning of regexp
+ (when (and outline-search-function (not (bobp))) (forward-char -1)))
+ (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp)))
+ (forward-char -1)))
(defun outline-next-heading ()
"Move to the next (possibly invisible) heading line."
(interactive)
;; Make sure we don't match the heading we're at.
- (if (and (bolp) (not (eobp))) (forward-char 1))
- (if (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
- nil 'move)
- (goto-char (match-beginning 0))))
+ (when (and (bolp) (not (eobp))) (forward-char 1))
+ (when (if outline-search-function
+ (funcall outline-search-function nil t)
+ (re-search-forward (concat "^\\(?:" outline-regexp "\\)")
+ nil 'move))
+ (goto-char (match-beginning 0))))
(defun outline-previous-heading ()
"Move to the previous (possibly invisible) heading line."
(interactive)
- (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
- nil 'move))
+ (if outline-search-function
+ (funcall outline-search-function nil t t)
+ (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+ nil 'move)))
(defsubst outline-invisible-p (&optional pos)
"Non-nil if the character after POS has outline invisible property.
@@ -632,8 +657,10 @@ Only visible heading lines are considered, unless
INVISIBLE-OK is non-nil."
(let (found)
(save-excursion
(while (not found)
- (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
- nil t)
+ (or (if outline-search-function
+ (funcall outline-search-function nil nil t)
+ (re-search-backward (concat "^\\(?:" outline-regexp "\\)")
+ nil t))
(signal 'outline-before-first-heading nil))
(setq found (and (or invisible-ok (not (outline-invisible-p)))
(point)))))
@@ -646,7 +673,9 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok
too."
(save-excursion
(beginning-of-line)
(and (bolp) (or invisible-ok (not (outline-invisible-p)))
- (looking-at outline-regexp))))
+ (if outline-search-function
+ (funcall outline-search-function nil nil nil t)
+ (looking-at outline-regexp)))))
(defun outline-insert-heading ()
"Insert a new heading at same depth at point."
@@ -758,7 +787,9 @@ nil for WHICH, or do not pass any argument)."
(while (and (progn (outline-next-heading) (not (eobp)))
(<= (funcall outline-level) level))))
(unless (eobp)
- (looking-at outline-regexp)
+ (if outline-search-function
+ (funcall outline-search-function nil nil nil t)
+ (looking-at outline-regexp))
(match-string-no-properties 0))))
;; Bummer!! There is no higher-level heading in the buffer.
(outline-invent-heading head nil))))
@@ -809,7 +840,9 @@ the match data is set appropriately."
(save-excursion
(setq end (copy-marker end))
(goto-char beg)
- (when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t)
+ (when (if outline-search-function
+ (funcall outline-search-function end)
+ (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t))
(goto-char (match-beginning 0))
(funcall fun)
(while (and (progn
@@ -877,21 +910,23 @@ A heading line is one that starts with a `*' (or that
(if (< arg 0)
(beginning-of-line)
(end-of-line))
- (let (found-heading-p)
+ (let ((regexp (unless outline-search-function
+ (concat "^\\(?:" outline-regexp "\\)")))
+ found-heading-p)
(while (and (not (bobp)) (< arg 0))
(while (and (not (bobp))
(setq found-heading-p
- (re-search-backward
- (concat "^\\(?:" outline-regexp "\\)")
- nil 'move))
+ (if outline-search-function
+ (funcall outline-search-function nil t t)
+ (re-search-backward regexp nil 'move)))
(outline-invisible-p)))
(setq arg (1+ arg)))
(while (and (not (eobp)) (> arg 0))
(while (and (not (eobp))
(setq found-heading-p
- (re-search-forward
- (concat "^\\(?:" outline-regexp "\\)")
- nil 'move))
+ (if outline-search-function
+ (funcall outline-search-function nil t)
+ (re-search-forward regexp nil 'move)))
(outline-invisible-p (match-beginning 0))))
(setq arg (1- arg)))
(if found-heading-p (beginning-of-line))))
@@ -1030,6 +1065,8 @@ Note that this does not hide the lines preceding the
first heading line."
;; Nullify the hook to avoid repeated calls to `outline-flag-region'
;; wasting lots of time running `lazy-lock-fontify-after-outline'
;; and run the hook finally.
+ ;; FIXME: The above comment seems outdated, as lazy-lock has been
+ ;; removed from Emacs.
(let (outline-view-change-hook)
(save-excursion
(save-restriction
@@ -1065,107 +1102,6 @@ If non-nil, EVENT should be a mouse event."
(mouse-set-point event))
(outline-flag-subtree t)))
-(defun outline--make-button-overlay (type)
- (let ((o (seq-find (lambda (o)
- (overlay-get o 'outline-button))
- (overlays-at (point)))))
- (unless o
- (setq o (make-overlay (point) (1+ (point))))
- (overlay-put o 'evaporate t)
- (overlay-put o 'follow-link 'mouse-face)
- (overlay-put o 'mouse-face 'highlight)
- (overlay-put o 'outline-button t))
- (let ((icon (icon-elements (if (eq type 'close)
- (if outline--use-rtl
- 'outline-close-rtl
- 'outline-close)
- 'outline-open)))
- (inhibit-read-only t))
- ;; In editing buffers we use overlays only, but in other buffers
- ;; we use a mix of text properties, text and overlays to make
- ;; movement commands work more logically.
- (when (derived-mode-p 'special-mode)
- (put-text-property (point) (1+ (point)) 'face (plist-get icon 'face)))
- (if-let ((image (plist-get icon 'image)))
- (overlay-put o 'display image)
- (overlay-put o 'display (concat (plist-get icon 'string)
- (string (char-after (point)))))
- (overlay-put o 'face (plist-get icon 'face))))
- o))
-
-(defun outline--make-margin-overlay (type)
- (let ((o (seq-find (lambda (o)
- (overlay-get o 'outline-margin))
- (overlays-at (point)))))
- (unless o
- (setq o (make-overlay (point) (1+ (point))))
- (overlay-put o 'evaporate t)
- (overlay-put o 'outline-margin t))
- (let ((icon (icon-elements (if (eq type 'close)
- (if outline--use-rtl
- 'outline-close-rtl-in-margins
- 'outline-close-in-margins)
- 'outline-open-in-margins)))
- (inhibit-read-only t))
- (overlay-put
- o 'before-string
- (propertize " " 'display
- `((margin ,(if outline--use-rtl
- 'right-margin 'left-margin))
- ,(or (plist-get icon 'image)
- (plist-get icon 'string))))))
- o))
-
-(defun outline--insert-open-button (&optional use-margins)
- (with-silent-modifications
- (save-excursion
- (beginning-of-line)
- (if use-margins
- (outline--make-margin-overlay 'open)
- (when (derived-mode-p 'special-mode)
- (let ((inhibit-read-only t))
- (insert " ")
- (beginning-of-line)))
- (let ((o (outline--make-button-overlay 'open)))
- (overlay-put o 'help-echo "Click to hide")
- (overlay-put o 'keymap
- (define-keymap
- "RET" #'outline-hide-subtree
- "<mouse-2>" #'outline-hide-subtree)))))))
-
-(defun outline--insert-close-button (&optional use-margins)
- (with-silent-modifications
- (save-excursion
- (beginning-of-line)
- (if use-margins
- (outline--make-margin-overlay 'close)
- (when (derived-mode-p 'special-mode)
- (let ((inhibit-read-only t))
- (insert " ")
- (beginning-of-line)))
- (let ((o (outline--make-button-overlay 'close)))
- (overlay-put o 'help-echo "Click to show")
- (overlay-put o 'keymap
- (define-keymap
- "RET" #'outline-show-subtree
- "<mouse-2>" #'outline-show-subtree)))))))
-
-(defun outline--fix-up-all-buttons (&optional from to)
- (when (or outline--use-buttons outline--use-margins)
- (when from
- (save-excursion
- (goto-char from)
- (setq from (line-beginning-position))))
- (outline-map-region
- (lambda ()
- (if (save-excursion
- (outline-end-of-heading)
- (seq-some (lambda (o) (eq (overlay-get o 'invisible) 'outline))
- (overlays-at (point))))
- (outline--insert-close-button outline--use-margins)
- (outline--insert-open-button outline--use-margins)))
- (or from (point-min)) (or to (point-max)))))
-
(define-obsolete-function-alias 'hide-subtree #'outline-hide-subtree "25.1")
(defun outline-hide-leaves ()
@@ -1212,8 +1148,11 @@ of the current heading, or to 1 if the current line is
not a heading."
(interactive (list
(cond
(current-prefix-arg (prefix-numeric-value current-prefix-arg))
- ((save-excursion (beginning-of-line)
- (looking-at outline-regexp))
+ ((save-excursion
+ (beginning-of-line)
+ (if outline-search-function
+ (funcall outline-search-function nil nil nil t)
+ (looking-at outline-regexp)))
(funcall outline-level))
(t 1))))
(if (< levels 1)
@@ -1360,7 +1299,9 @@ If INVISIBLE-OK is non-nil, also consider invisible
lines."
(setq level (funcall outline-level)))
(setq start-level level))
(setq arg (- arg 1))))
- (looking-at outline-regexp))
+ (if outline-search-function
+ (funcall outline-search-function nil nil nil t)
+ (looking-at outline-regexp)))
(defun outline-forward-same-level (arg)
"Move forward to the ARG'th subheading at same level as this one.
@@ -1418,6 +1359,60 @@ If there is no such heading, return nil."
(if (< (funcall outline-level) level)
nil
(point)))))
+
+
+;;; Search text-property for outline headings
+
+;;;###autoload
+(defun outline-search-level (&optional bound move backward looking-at)
+ "Search for the next text property `outline-level'.
+The arguments are the same as in `outline-search-text-property',
+except the hard-coded property name `outline-level'.
+This function is intended to be used in `outline-search-function'."
+ (outline-search-text-property 'outline-level nil bound move backward
looking-at))
+
+(autoload 'text-property-search-forward "text-property-search")
+(autoload 'text-property-search-backward "text-property-search")
+
+(defun outline-search-text-property (property &optional value bound move
backward looking-at)
+ "Search for the next text property PROPERTY with VALUE.
+The rest of arguments are described in `outline-search-function'."
+ (if looking-at
+ (when (if value (eq (get-text-property (point) property) value)
+ (get-text-property (point) property))
+ (set-match-data (list (pos-bol) (pos-eol)))
+ t)
+ ;; Go to the end when in the middle of heading
+ (when (and (not backward)
+ (if value (eq (get-text-property (point) property) value)
+ (get-text-property (point) property))
+ (not (or (bobp)
+ (not (if value
+ (eq (get-text-property (1- (point)) property)
value)
+ (get-text-property (1- (point)) property))))))
+ (goto-char (1+ (pos-eol))))
+ (let ((prop-match (if backward
+ (text-property-search-backward property value (and
value t))
+ (text-property-search-forward property value (and
value t)))))
+ (if prop-match
+ (let ((beg (prop-match-beginning prop-match))
+ (end (prop-match-end prop-match)))
+ (if (or (null bound) (if backward (>= beg bound) (<= end bound)))
+ (cond (backward
+ (goto-char beg)
+ (goto-char (pos-bol))
+ (set-match-data (list (point) end))
+ t)
+ (t
+ (goto-char end)
+ (goto-char (if (bolp) (1- (point)) (pos-eol)))
+ (set-match-data (list beg (point)))
+ t))
+ (when move (goto-char bound))
+ nil))
+ (when move (goto-char (or bound (if backward (point-min)
(point-max)))))
+ nil))))
+
(defun outline-headers-as-kill (beg end)
"Save the visible outline headers between BEG and END to the kill ring.
@@ -1451,6 +1446,9 @@ convenient way to make a table of contents of the buffer."
(insert "\n\n"))))))
(kill-new (buffer-string)))))))
+
+;;; Initial visibility
+
(defcustom outline-default-state nil
"If non-nil, some headings are initially outlined.
@@ -1629,6 +1627,9 @@ LEVEL, decides of subtree visibility according to
beg end)))
(run-hooks 'outline-view-change-hook)))
+
+;;; Visibility cycling
+
(defun outline--cycle-state ()
"Return the cycle state of current heading.
Return either `hide-all', `headings-only', or `show-all'."
@@ -1742,6 +1743,103 @@ With a prefix argument, show headings up to that LEVEL."
(message "Show all")))))
+;;; Button/margin indicators
+
+(defun outline--create-button-icons ()
+ (pcase outline-minor-mode-use-buttons
+ ('in-margins
+ (mapcar
+ (lambda (icon-name)
+ (let* ((icon (icon-elements icon-name))
+ (face (plist-get icon 'face))
+ (string (plist-get icon 'string))
+ (image (plist-get icon 'image))
+ (display `((margin ,(if outline--use-rtl
+ 'right-margin 'left-margin))
+ ,(or image (if face (propertize
+ string 'face face)
+ string))))
+ (space (propertize " " 'display display)))
+ (if (and image face) (propertize space 'face face) space)))
+ (list 'outline-open-in-margins
+ (if outline--use-rtl
+ 'outline-close-rtl-in-margins
+ 'outline-close-in-margins))))
+ ('insert
+ (mapcar
+ (lambda (icon-name)
+ (icon-elements icon-name))
+ (list 'outline-open
+ (if outline--use-rtl 'outline-close-rtl 'outline-close))))
+ (_
+ (mapcar
+ (lambda (icon-name)
+ (propertize (icon-string icon-name)
+ 'mouse-face 'default
+ 'follow-link 'mouse-face
+ 'keymap (define-keymap "<mouse-2>" #'outline-cycle)))
+ (list 'outline-open
+ (if outline--use-rtl 'outline-close-rtl 'outline-close))))))
+
+(defun outline--insert-button (type)
+ (with-silent-modifications
+ (save-excursion
+ (beginning-of-line)
+ (let ((icon (nth (if (eq type 'close) 1 0) outline--button-icons))
+ (o (seq-find (lambda (o) (overlay-get o 'outline-button))
+ (overlays-at (point)))))
+ (unless o
+ (when (eq outline-minor-mode-use-buttons 'insert)
+ (let ((inhibit-read-only t))
+ (insert " ")
+ (beginning-of-line)))
+ (setq o (make-overlay (point) (1+ (point))))
+ (overlay-put o 'outline-button t)
+ (overlay-put o 'evaporate t))
+ (pcase outline-minor-mode-use-buttons
+ ('insert
+ (overlay-put o 'display (or (plist-get icon 'image)
+ (plist-get icon 'string)))
+ (overlay-put o 'face (plist-get icon 'face))
+ (overlay-put o 'follow-link 'mouse-face)
+ (overlay-put o 'mouse-face 'highlight)
+ (overlay-put o 'keymap (define-keymap
+ "RET" #'outline-cycle
+ "<mouse-2>" #'outline-cycle))
+ (overlay-put o 'help-echo (if (eq type 'close)
+ "Click to show"
+ "Click to hide")))
+ ('in-margins
+ (overlay-put o 'before-string icon)
+ (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle)))
+ (_
+ (overlay-put o 'before-string icon)
+ (overlay-put o 'keymap (define-keymap "RET" #'outline-cycle))))))))
+
+(defun outline--fix-up-all-buttons (&optional from to)
+ (when outline-minor-mode-use-buttons
+ (when from
+ (save-excursion
+ (goto-char from)
+ (setq from (line-beginning-position))))
+ (outline-map-region
+ (lambda ()
+ (let ((close-p (save-excursion
+ (outline-end-of-heading)
+ (seq-some (lambda (o) (eq (overlay-get o 'invisible)
+ 'outline))
+ (overlays-at (point))))))
+ (outline--insert-button (if close-p 'close 'open))))
+ (or from (point-min)) (or to (point-max)))))
+
+(defun outline--fix-buttons-after-change (beg end _len)
+ ;; Handle whole lines
+ (save-excursion (goto-char beg) (setq beg (pos-bol)))
+ (save-excursion (goto-char end) (setq end (pos-eol)))
+ (remove-overlays beg end 'outline-button t)
+ (outline--fix-up-all-buttons beg end))
+
+
(defvar-keymap outline-navigation-repeat-map
"C-b" #'outline-backward-same-level
"b" #'outline-backward-same-level
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 6fe29d9dcf..ef286b70fe 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -646,15 +646,12 @@ parts of the list.
The OFFSET argument is added to/taken away from the index that will be
used. This is really only useful with `first' and `last', for
accessing absolute argument positions."
- (setq index
- (if (eq index 'first)
- 0
- (if (eq index 'last)
- pcomplete-last
- (- pcomplete-index (or index 0)))))
- (if offset
- (setq index (+ index offset)))
- (nth index pcomplete-args))
+ (nth (+ (pcase index
+ ('first 0)
+ ('last pcomplete-last)
+ (_ (- pcomplete-index (or index 0))))
+ (or offset 0))
+ pcomplete-args))
(defun pcomplete-begin (&optional index offset)
"Return the beginning position of the INDEXth argument.
@@ -1213,9 +1210,7 @@ Returns nil if no completion was inserted.
Returns `sole' if completed with the only completion match.
Returns `shortest' if completed with the shortest of the matches.
Returns `partial' if completed as far as possible with the matches.
-Returns `listed' if a completion listing was shown.
-
-See also `pcomplete-filename'."
+Returns `listed' if a completion listing was shown."
(let* ((completion-ignore-case completion-ignore-case)
(completions (all-completions stub candidates))
(entry (try-completion stub candidates))
diff --git a/lisp/play/zone.el b/lisp/play/zone.el
index 34523fef05..a470f23dfe 100644
--- a/lisp/play/zone.el
+++ b/lisp/play/zone.el
@@ -103,9 +103,24 @@ If the element is a function or a list of a function and a
number,
program))))
;;;###autoload
-(defun zone ()
- "Zone out, completely."
- (interactive)
+(defun zone (&optional pgm)
+ "Zone out, completely.
+With a prefix argument the user is prompted for a program to run.
+When called from Lisp the optional argument PGM can be used to
+run a specific program. The program must be a member of
+`zone-programs'."
+ (interactive
+ (and current-prefix-arg
+ (let ((choice (completing-read
+ "Program: "
+ (mapcar
+ (lambda (prog)
+ (substring (symbol-name prog) 9))
+ zone-programs)
+ nil t)))
+ (list (intern (concat "zone-pgm-" choice))))))
+ (unless pgm
+ (setq pgm (aref zone-programs (random (length zone-programs)))))
(save-window-excursion
(let ((f (selected-frame))
(outbuf (get-buffer-create "*zone*"))
@@ -124,9 +139,8 @@ If the element is a function or a list of a function and a
number,
(untabify (point-min) (point-max))
(set-window-start (selected-window) (point-min))
(set-window-point (selected-window) wp)
- (sit-for 0 500)
- (let ((pgm (elt zone-programs (random (length zone-programs))))
- (ct (and f (frame-parameter f 'cursor-type)))
+ (sit-for 0.500)
+ (let ((ct (and f (frame-parameter f 'cursor-type)))
(show-trailing-whitespace nil)
restore)
(when ct
@@ -204,8 +218,7 @@ If the element is a function or a list of a function and a
number,
(insert s)))
(defun zone-shift-left ()
- (let ((inhibit-point-motion-hooks t)
- s)
+ (let (s)
(while (not (eobp))
(unless (eolp)
(setq s (buffer-substring (point) (1+ (point))))
@@ -216,8 +229,7 @@ If the element is a function or a list of a function and a
number,
(defun zone-shift-right ()
(goto-char (point-max))
- (let ((inhibit-point-motion-hooks t)
- s)
+ (let (s)
(while (not (bobp))
(unless (bolp)
(setq s (buffer-substring (1- (point)) (point)))
@@ -237,7 +249,7 @@ If the element is a function or a list of a function and a
number,
(while (not (input-pending-p))
(funcall (elt ops (random (length ops))))
(goto-char (point-min))
- (sit-for 0 10))))
+ (sit-for 0.01))))
;;;; whacking chars
@@ -250,7 +262,7 @@ If the element is a function or a list of a function and a
number,
(aset tbl i (+ 48 (random (- 123 48))))
(setq i (1+ i)))
(translate-region (point-min) (point-max) tbl)
- (sit-for 0 2)))))
+ (sit-for 0.002)))))
(put 'zone-pgm-whack-chars 'wc-tbl
(let ((tbl (make-string 128 ?x))
@@ -278,7 +290,7 @@ If the element is a function or a list of a function and a
number,
(delete-char 1)
(insert " ")))
(forward-char 1))))
- (sit-for 0 2))))
+ (sit-for 0.002))))
(defun zone-pgm-dissolve ()
(zone-remove-text)
@@ -300,7 +312,7 @@ If the element is a function or a list of a function and a
number,
(insert " ")))
(forward-char 1)))
(setq i (1+ i))
- (sit-for 0 2)))
+ (sit-for 0.002)))
(zone-pgm-jitter))
(defun zone-pgm-explode ()
@@ -335,7 +347,7 @@ If the element is a function or a list of a function and a
number,
(upcase i)))
(setq i (+ i (1+ (random 5)))))
(translate-region (point-min) (point-max) tbl)
- (sit-for 0 2))))
+ (sit-for 0.002))))
(defun zone-pgm-putz-with-case ()
(goto-char (point-min))
@@ -347,7 +359,7 @@ If the element is a function or a list of a function and a
number,
'downcase-region) (1- np) np)
(setq np (+ np (1+ (random 5))))))
(goto-char (point-min))
- (sit-for 0 2)))
+ (sit-for 0.002)))
;;;; rotating
@@ -448,8 +460,7 @@ If the element is a function or a list of a function and a
number,
(defun zone-fill-out-screen (width height)
(let ((start (window-start))
- (line (make-string width 32))
- (inhibit-point-motion-hooks t))
+ (line (make-string width 32)))
(goto-char start)
;; fill out rectangular ws block
(while (progn (end-of-line)
@@ -664,8 +675,7 @@ If nil, `zone-pgm-random-life' chooses a value from 0-3
(inclusive).")
(setq c (point))
(move-to-column 9)
(setq col (cons (buffer-substring (point) c) col))
-; (let ((inhibit-point-motion-hooks t))
- (end-of-line 0);)
+ (end-of-line 0)
(forward-char -10))
(let ((life-patterns (vector
(if (and col (search-forward "@" max t))
diff --git a/lisp/printing.el b/lisp/printing.el
index 0654dcda3d..767648df4d 100644
--- a/lisp/printing.el
+++ b/lisp/printing.el
@@ -944,7 +944,7 @@
;;
`https://www.gnu.org/software/ghostscript/ghostscript.html'
;; gsprint `https://www.cs.wisc.edu/~ghost/gsview/gsprint.htm'.
;; enscript `https://people.ssh.fi/mtr/genscript/'
-;; psnup `http://gnuwin32.sourceforge.net/packages/psutils.htm'
+;; psnup `https://gnuwin32.sourceforge.net/packages/psutils.htm'
;; redmon `http://www.ghostgum.com.au/software/redmon.htm'
;;
;;
@@ -1752,7 +1752,7 @@ Useful links:
`https://linux.die.net/man/1/lp'
* GNU utilities for w32 (cp.exe)
- `http://unxutils.sourceforge.net/'"
+ `https://unxutils.sourceforge.net/'"
:type '(repeat
(list
:tag "PostScript Printer"
@@ -2382,7 +2382,7 @@ Useful links:
`http://gershwin.ens.fr/vdaniel/Doc-Locale/Outils-Gnu-Linux/PsUtils/'
* psnup (PsUtils for Windows)
- `http://gnuwin32.sourceforge.net/packages/psutils.htm'
+ `https://gnuwin32.sourceforge.net/packages/psutils.htm'
* psnup documentation (GNU or Unix - or type `man psnup')
`https://linux.die.net/man/1/psnup'
diff --git a/lisp/proced.el b/lisp/proced.el
index a774f2dd1e..ac44ae1513 100644
--- a/lisp/proced.el
+++ b/lisp/proced.el
@@ -140,8 +140,8 @@ the external command (usually \"kill\")."
(nice "Ni" "%3d" 3 proced-< t (nice pid) (t t nil))
(thcount "THCount" "%d" right proced-< t (thcount pid) (nil t t))
(start "Start" proced-format-start 6 proced-time-lessp nil (start pid)
(t t nil))
- (vsize "VSize" "%d" right proced-< t (vsize pid) (nil t t))
- (rss "RSS" "%d" right proced-< t (rss pid) (nil t t))
+ (vsize "VSize" proced-format-memory right proced-< t (vsize pid) (nil
t t))
+ (rss "RSS" proced-format-memory right proced-< t (rss pid) (nil t
t))
(etime "ETime" proced-format-time right proced-time-lessp t (etime
pid) (nil t t))
(pcpu "%CPU" "%.1f" right proced-< t (pcpu pid) (nil t t))
(pmem "%Mem" "%.1f" right proced-< t (pmem pid) (nil t t))
@@ -740,12 +740,18 @@ Proced buffers."
"Type \\<proced-mode-map>\\[quit-window] to quit, \\[proced-help] for
help")))))
(defun proced-auto-update-timer ()
- "Auto-update Proced buffers using `run-at-time'."
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (if (and (eq major-mode 'proced-mode)
- proced-auto-update-flag)
- (proced-update t t)))))
+ "Auto-update Proced buffers using `run-at-time'.
+
+If there are no proced buffers, cancel the timer."
+ (unless (seq-filter (lambda (buf)
+ (with-current-buffer buf
+ (when (eq major-mode 'proced-mode)
+ (if proced-auto-update-flag
+ (proced-update t t))
+ t)))
+ (buffer-list))
+ (cancel-timer proced-auto-update-timer)
+ (setq proced-auto-update-timer nil)))
(defun proced-toggle-auto-update (arg)
"Change whether this Proced buffer is updated automatically.
@@ -1425,6 +1431,10 @@ The return string is always 6 characters wide."
Replace newline characters by \"^J\" (two characters)."
(string-replace "\n" "^J" args))
+(defun proced-format-memory (kilobytes)
+ "Format KILOBYTES in a human readable format."
+ (funcall byte-count-to-string-function (* 1024 kilobytes)))
+
(defun proced-format (process-alist format)
"Display PROCESS-ALIST using FORMAT."
(if (symbolp format)
diff --git a/lisp/profiler.el b/lisp/profiler.el
index 8670e5786a..e66b1ff42a 100644
--- a/lisp/profiler.el
+++ b/lisp/profiler.el
@@ -534,72 +534,71 @@ RET: expand or collapse"))
;;; Report mode
-(defvar profiler-report-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "n" 'profiler-report-next-entry)
- (define-key map "p" 'profiler-report-previous-entry)
- ;; I find it annoying more than helpful to not be able to navigate
- ;; normally with the cursor keys. --Stef
- ;; (define-key map [down] 'profiler-report-next-entry)
- ;; (define-key map [up] 'profiler-report-previous-entry)
- (define-key map "\r" 'profiler-report-toggle-entry)
- (define-key map "\t" 'profiler-report-toggle-entry)
- (define-key map "i" 'profiler-report-toggle-entry)
- (define-key map "f" 'profiler-report-find-entry)
- (define-key map "j" 'profiler-report-find-entry)
- (define-key map [follow-link] 'mouse-face)
- (define-key map [mouse-2] 'profiler-report-find-entry)
- (define-key map "d" 'profiler-report-describe-entry)
- (define-key map "C" 'profiler-report-render-calltree)
- (define-key map "B" 'profiler-report-render-reversed-calltree)
- (define-key map "A" 'profiler-report-ascending-sort)
- (define-key map "D" 'profiler-report-descending-sort)
- (define-key map "=" 'profiler-report-compare-profile)
- (define-key map (kbd "C-x C-w") 'profiler-report-write-profile)
- (easy-menu-define profiler-report-menu map "Menu for Profiler Report
mode."
- '("Profiler"
- ["Next Entry" profiler-report-next-entry :active t
- :help "Move to next entry"]
- ["Previous Entry" profiler-report-previous-entry :active t
- :help "Move to previous entry"]
- "--"
- ["Toggle Entry" profiler-report-toggle-entry
- :active (profiler-report-calltree-at-point)
- :help "Expand or collapse the current entry"]
- ["Find Entry" profiler-report-find-entry
- ;; FIXME should deactivate if not on a known function.
- :active (profiler-report-calltree-at-point)
- :help "Find the definition of the current entry"]
- ["Describe Entry" profiler-report-describe-entry
- :active (profiler-report-calltree-at-point)
- :help "Show the documentation of the current entry"]
- "--"
- ["Show Calltree" profiler-report-render-calltree
- :active profiler-report-reversed
- :help "Show calltree view"]
- ["Show Reversed Calltree" profiler-report-render-reversed-calltree
- :active (not profiler-report-reversed)
- :help "Show reversed calltree view"]
- ["Sort Ascending" profiler-report-ascending-sort
- :active (not (eq profiler-report-order 'ascending))
- :help "Sort calltree view in ascending order"]
- ["Sort Descending" profiler-report-descending-sort
- :active (not (eq profiler-report-order 'descending))
- :help "Sort calltree view in descending order"]
- "--"
- ["Compare Profile..." profiler-report-compare-profile :active t
- :help "Compare current profile with another"]
- ["Write Profile..." profiler-report-write-profile :active t
- :help "Write current profile to a file"]
- "--"
- ["Start Profiler" profiler-start :active (not (profiler-running-p))
- :help "Start profiling"]
- ["Stop Profiler" profiler-stop :active (profiler-running-p)
- :help "Stop profiling"]
- ["New Report" profiler-report :active (profiler-running-p)
- :help "Make a new report"]))
- map)
- "Keymap for `profiler-report-mode'.")
+(defvar-keymap profiler-report-mode-map
+ :doc "Keymap for `profiler-report-mode'."
+ "n" #'profiler-report-next-entry
+ "p" #'profiler-report-previous-entry
+ ;; I find it annoying more than helpful to not be able to navigate
+ ;; normally with the cursor keys. --Stef
+ ;; "<down>" #'profiler-report-next-entry
+ ;; "<up>" #'profiler-report-previous-entry
+ "RET" #'profiler-report-toggle-entry
+ "TAB" #'profiler-report-toggle-entry
+ "i" #'profiler-report-toggle-entry
+ "f" #'profiler-report-find-entry
+ "j" #'profiler-report-find-entry
+ "d" #'profiler-report-describe-entry
+ "C" #'profiler-report-render-calltree
+ "B" #'profiler-report-render-reversed-calltree
+ "A" #'profiler-report-ascending-sort
+ "D" #'profiler-report-descending-sort
+ "=" #'profiler-report-compare-profile
+ "C-x C-w" #'profiler-report-write-profile
+ "<follow-link>" 'mouse-face
+ "<mouse-2>" #'profiler-report-find-entry
+
+ :menu
+ '("Profiler"
+ ["Next Entry" profiler-report-next-entry :active t
+ :help "Move to next entry"]
+ ["Previous Entry" profiler-report-previous-entry :active t
+ :help "Move to previous entry"]
+ "--"
+ ["Toggle Entry" profiler-report-toggle-entry
+ :active (profiler-report-calltree-at-point)
+ :help "Expand or collapse the current entry"]
+ ["Find Entry" profiler-report-find-entry
+ ;; FIXME should deactivate if not on a known function.
+ :active (profiler-report-calltree-at-point)
+ :help "Find the definition of the current entry"]
+ ["Describe Entry" profiler-report-describe-entry
+ :active (profiler-report-calltree-at-point)
+ :help "Show the documentation of the current entry"]
+ "--"
+ ["Show Calltree" profiler-report-render-calltree
+ :active profiler-report-reversed
+ :help "Show calltree view"]
+ ["Show Reversed Calltree" profiler-report-render-reversed-calltree
+ :active (not profiler-report-reversed)
+ :help "Show reversed calltree view"]
+ ["Sort Ascending" profiler-report-ascending-sort
+ :active (not (eq profiler-report-order 'ascending))
+ :help "Sort calltree view in ascending order"]
+ ["Sort Descending" profiler-report-descending-sort
+ :active (not (eq profiler-report-order 'descending))
+ :help "Sort calltree view in descending order"]
+ "--"
+ ["Compare Profile..." profiler-report-compare-profile :active t
+ :help "Compare current profile with another"]
+ ["Write Profile..." profiler-report-write-profile :active t
+ :help "Write current profile to a file"]
+ "--"
+ ["Start Profiler" profiler-start :active (not (profiler-running-p))
+ :help "Start profiling"]
+ ["Stop Profiler" profiler-stop :active (profiler-running-p)
+ :help "Stop profiling"]
+ ["New Report" profiler-report :active (profiler-running-p)
+ :help "Make a new report"]))
(defun profiler-report-make-buffer-name (profile)
(format "*%s-Profiler-Report %s*"
diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el
index 5002a3bbfa..1aee1107e6 100644
--- a/lisp/progmodes/antlr-mode.el
+++ b/lisp/progmodes/antlr-mode.el
@@ -5,7 +5,7 @@
;; Author: Christoph Wedler <Christoph.Wedler@sap.com>
;; Keywords: languages, ANTLR, code generator
;; Version: 2.2c
-;; URL: http://antlr-mode.sourceforge.net/
+;; URL: https://antlr-mode.sourceforge.net/
;; This file is part of GNU Emacs.
@@ -29,7 +29,7 @@
;; supported options and various other things like running ANTLR from within
;; Emacs.
-;; For details, check <http://antlr-mode.sourceforge.net/> or, if you prefer
+;; For details, check <https://antlr-mode.sourceforge.net/> or, if you prefer
;; the manual style, follow all commands mentioned in the documentation of
;; `antlr-mode'. ANTLR is a LL(k)-based recognition tool which generates
;; lexers, parsers and tree transformers in Java, C++ or Sather and can be
@@ -83,14 +83,6 @@
(require 'easymenu))
(require 'cc-mode)
-;; More compile-time-macros
-(eval-when-compile
- (defmacro save-buffer-state-x (&rest body) ; similar to EMACS/lazy-lock.el
- (declare (debug t) (indent 0))
- `(let ((inhibit-point-motion-hooks t))
- (with-silent-modifications
- ,@body))))
-
(defvar outline-level)
(defvar imenu-use-markers)
(defvar imenu-create-index-function)
@@ -114,12 +106,12 @@
"Major mode for ANTLR grammar files."
:group 'languages
:link '(emacs-commentary-link "antlr-mode.el")
- :link '(url-link "http://antlr-mode.sourceforge.net/";)
+ :link '(url-link "https://antlr-mode.sourceforge.net/";)
:prefix "antlr-")
(defconst antlr-version "2.2c"
"ANTLR major mode version number.
-Check <http://antlr-mode.sourceforge.net/> for the newest.")
+Check <https://antlr-mode.sourceforge.net/> for the newest.")
;;;===========================================================================
@@ -1320,7 +1312,7 @@ actions if ARG is 0 or negative. See
`antlr-action-visibility'.
Display a message unless optional argument SILENT is non-nil."
(interactive "p")
- (save-buffer-state-x
+ (with-silent-modifications
(if (> arg 0)
(let ((regexp (if (= arg 1) "[]}]" "}"))
(diff (and antlr-action-visibility
diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el
index 4b8154dafe..735d829769 100644
--- a/lisp/progmodes/cc-bytecomp.el
+++ b/lisp/progmodes/cc-bytecomp.el
@@ -287,7 +287,7 @@ perhaps a `cc-bytecomp-restore-environment' is forgotten
somewhere"))
(cons cc-file cc-bytecomp-loaded-files))
(cc-bytecomp-debug-msg
"cc-bytecomp-load: Loading %S" cc-file)
- ;; native-comp may async compile also intalled el.gz
+ ;; native-comp may async compile also installed el.gz
;; files therefore we may have to load here other el.gz.
(load cc-part nil t)
(cc-bytecomp-debug-msg
diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el
index 38e9d6011d..7bfd6bdbd9 100644
--- a/lisp/progmodes/cc-cmds.el
+++ b/lisp/progmodes/cc-cmds.el
@@ -1456,7 +1456,7 @@ keyword on the line, the keyword is not inserted inside a
literal, and
(defun c-align-cpp-indent-to-body ()
"Align a \"#pragma\" line under the previous line.
-This function is intented for use as a member of `c-special-indent-hook'."
+This function is intended for use as a member of `c-special-indent-hook'."
(when (assq 'cpp-macro c-syntactic-context)
(when
(save-excursion
diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el
index 4f1a08cfa0..b13f6a5914 100644
--- a/lisp/progmodes/cc-defs.el
+++ b/lisp/progmodes/cc-defs.el
@@ -60,7 +60,6 @@
(cc-bytecomp-defun region-active-p) ; XEmacs
(cc-bytecomp-defvar mark-active) ; Emacs
(cc-bytecomp-defvar deactivate-mark) ; Emacs
-(cc-bytecomp-defvar inhibit-point-motion-hooks) ; Emacs
(cc-bytecomp-defvar parse-sexp-lookup-properties) ; Emacs
(cc-bytecomp-defvar text-property-default-nonsticky) ; Emacs 21
(cc-bytecomp-defun string-to-syntax) ; Emacs 21
@@ -87,7 +86,7 @@
;;; Variables also used at compile time.
-(defconst c-version "5.35.1"
+(defconst c-version "5.35.2"
"CC Mode version number.")
(defconst c-version-sym (intern c-version))
diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el
index 0ac96219a1..7e6dd43175 100644
--- a/lisp/progmodes/cc-engine.el
+++ b/lisp/progmodes/cc-engine.el
@@ -6052,7 +6052,7 @@ comment at the start of cc-engine.el for more info."
;; the like.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The approximate interval at which we cache the value of the brace stack.
-(defconst c-bs-interval 5000)
+(defconst c-bs-interval 2000)
;; The list of cached values of the brace stack. Each value in the list is a
;; cons of the position it is valid for and the value of the stack as
;; described above.
@@ -6158,9 +6158,10 @@ comment at the start of cc-engine.el for more info."
(setq s (cdr s))))
((c-keyword-member kwd-sym 'c-flat-decl-block-kwds)
(push 0 s))))
- ;; The failing `c-syntactic-re-search-forward' may have left us in the
- ;; middle of a token, which might be a significant token. Fix this!
- (c-beginning-of-current-token)
+ (when (> prev-match-pos 1) ; Has the search matched at least once?
+ ;; The failing `c-syntactic-re-search-forward' may have left us in the
+ ;; middle of a token, which might be a significant token. Fix this!
+ (c-beginning-of-current-token))
(cons (point)
(cons bound-<> s)))))
@@ -6693,8 +6694,7 @@ comment at the start of cc-engine.el for more info."
;; syntactic ws.
(when (and cfd-match-pos (< cfd-match-pos syntactic-pos))
(goto-char syntactic-pos)
- (c-forward-syntactic-ws
- (min (+ (point) 2000) (point-max)))
+ (c-forward-syntactic-ws cfd-limit)
(and cfd-continue-pos
(< cfd-continue-pos (point))
(setq cfd-token-pos (point))))
@@ -6735,8 +6735,7 @@ comment at the start of cc-engine.el for more info."
;; can't be nested, and that's already been done in
;; `c-find-decl-prefix-search'.
(when (> cfd-continue-pos cfd-token-pos)
- (c-forward-syntactic-ws
- (min (+ (point) 2000) (point-max)))
+ (c-forward-syntactic-ws cfd-limit)
(setq cfd-token-pos (point)))
;; Continue if the following token fails the
@@ -6964,7 +6963,7 @@ comment at the start of cc-engine.el for more info."
;; At each buffer change, the syntax-table properties are removed in a
;; before-change function and reapplied, when needed, in an
;; after-change function. It is far more important that the
-;; properties get removed when they they are spurious than that they
+;; properties get removed when they are spurious than that they
;; be present when wanted.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c-clear-<-pair-props (&optional pos)
@@ -7357,7 +7356,7 @@ multi-line strings (but not C++, for example)."
(defun c-ml-string-opener-intersects-region (&optional start finish)
;; If any part of the region [START FINISH] is inside an ml-string opener,
;; return a dotted list of the start, end and double-quote position of that
- ;; opener. That list wlll not include any "context characters" before or
+ ;; opener. That list will not include any "context characters" before or
;; after the opener. If an opener is found, the match-data will indicate
;; it, with (match-string 1) being the entire delimiter, and (match-string
;; 2) the "main" double-quote. Otherwise, the match-data is undefined.
@@ -8196,7 +8195,8 @@ multi-line strings (but not C++, for example)."
;; treat possible types (i.e. those that it normally returns 'maybe or
;; 'found for) as actual types (and always return 'found for them).
;; This means that it records them in `c-record-type-identifiers' if
-;; that is set, and that it adds them to `c-found-types'.
+;; that is set, and that if its value is t (not 'just-one), it adds
+;; them to `c-found-types'.
(defvar c-promote-possible-types nil)
;; Dynamically bound variable that instructs `c-forward-<>-arglist' to
@@ -8356,6 +8356,23 @@ multi-line strings (but not C++, for example)."
(goto-char here))))
t)
+(defun c-forward-over-colon-type-list ()
+ ;; If we're at a sequence of characters which can extend from, e.g.,
+ ;; a class name up to a colon introducing an inheritance list,
+ ;; move forward over them, including the colon, and return non-nil.
+ ;; Otherwise return nil, leaving point unmoved.
+ (let ((here (point)) pos)
+ (while (and (re-search-forward c-sub-colon-type-list-re nil t)
+ (not (eq (char-after) ?:))
+ (c-major-mode-is 'c++-mode)
+ (setq pos (c-looking-at-c++-attribute)))
+ (goto-char pos))
+ (if (eq (char-after) ?:)
+ (progn (forward-char)
+ t)
+ (goto-char here)
+ nil)))
+
(defun c-forward-keyword-clause (match)
;; Submatch MATCH in the current match data is assumed to surround a
;; token. If it's a keyword, move over it and any immediately
@@ -8463,12 +8480,11 @@ multi-line strings (but not C++, for example)."
(and c-record-type-identifiers
(progn
;; If a keyword matched both one of the types above and
- ;; this one, we match `c-colon-type-list-re' after the
+ ;; this one, we move forward to the colon following the
;; clause matched above.
(goto-char safe-pos)
- (looking-at c-colon-type-list-re))
+ (c-forward-over-colon-type-list))
(progn
- (goto-char (match-end 0))
(c-forward-syntactic-ws)
(c-forward-keyword-prefixed-id type))
;; There's a type after the `c-colon-type-list-re' match
@@ -8921,8 +8937,16 @@ multi-line strings (but not C++, for example)."
;; Got some other operator.
(setq c-last-identifier-range
(cons (point) (match-end 0)))
+ (if (and (eq (char-after) ?\")
+ (eq (char-after (1+ (point))) ?\"))
+ ;; operator"" has an (?)optional tag after it.
+ (progn
+ (goto-char (match-end 0))
+ (c-forward-syntactic-ws lim+)
+ (when (c-on-identifier)
+ (c-forward-token-2 1 nil lim+)))
(goto-char (match-end 0))
- (c-forward-syntactic-ws lim+)
+ (c-forward-syntactic-ws lim+))
(setq pos (point)
res 'operator)))
@@ -9012,7 +9036,8 @@ multi-line strings (but not C++, for example)."
;; o - 'found if it's a type that matches one in `c-found-types';
;; o - 'maybe if it's an identifier that might be a type;
;; o - 'decltype if it's a decltype(variable) declaration; - or
- ;; o - 'no-id if "auto" precluded parsing a type identifier.
+ ;; o - 'no-id if "auto" precluded parsing a type identifier (C++)
+ ;; or the type int was implicit (C).
;; o - nil if it can't be a type (the point isn't moved then).
;;
;; The point is assumed to be at the beginning of a token.
@@ -9031,18 +9056,21 @@ multi-line strings (but not C++, for example)."
(c-forward-<>-arglist t)
(c-forward-syntactic-ws))
- (let ((start (point)) pos res name-res id-start id-end id-range)
+ (let ((start (point)) pos res name-res id-start id-end id-range
+ post-prefix-pos)
;; Skip leading type modifiers. If any are found we know it's a
;; prefix of a type.
- (when c-opt-type-modifier-prefix-key ; e.g. "const" "volatile", but NOT
"typedef"
- (while (looking-at c-opt-type-modifier-prefix-key)
- (when (looking-at c-no-type-key)
- (setq res 'no-id))
+ (when c-maybe-typeless-specifier-re
+ (while (looking-at c-maybe-typeless-specifier-re)
+ (save-match-data
+ (when (looking-at c-no-type-key)
+ (setq res 'no-id)))
(goto-char (match-end 1))
(c-forward-syntactic-ws)
(or (eq res 'no-id)
(setq res 'prefix))))
+ (setq post-prefix-pos (point))
(cond
((looking-at c-typeof-key) ; e.g. C++'s "decltype".
@@ -9075,9 +9103,14 @@ multi-line strings (but not C++, for example)."
(setq name-res (c-forward-name))
(setq res (not (null name-res)))
(when (eq name-res t)
- ;; In many languages the name can be used without the
- ;; prefix, so we add it to `c-found-types'.
- (c-add-type pos (point))
+ ;; With some keywords the name can be used without the prefix, so we
+ ;; add the name to `c-found-types' when this is the case.
+ (when (save-excursion
+ (goto-char post-prefix-pos)
+ (looking-at c-self-contained-typename-key))
+ (c-add-type pos (save-excursion
+ (c-backward-syntactic-ws)
+ (point))))
(when (and c-record-type-identifiers
c-last-identifier-range)
(c-record-type-id c-last-identifier-range)))
@@ -9097,6 +9130,9 @@ multi-line strings (but not C++, for example)."
(not (eq res 'no-id))
(progn
(setq pos nil)
+ (while (and c-opt-cpp-prefix
+ (looking-at c-noise-macro-with-parens-name-re))
+ (c-forward-noise-clause))
(if (looking-at c-identifier-start)
(save-excursion
(setq id-start (point)
@@ -9156,13 +9192,29 @@ multi-line strings (but not C++, for example)."
(goto-char (match-end 1))
(c-forward-syntactic-ws)))))
+ ((and (eq name-res t)
+ (eq res 'prefix)
+ (c-major-mode-is 'c-mode)
+ (save-excursion
+ (goto-char id-end)
+ (and (not (looking-at c-symbol-start))
+ (not (looking-at c-type-decl-prefix-key)))))
+ ;; A C specifier followed by an implicit int, e.g.
+ ;; "register count;"
+ (goto-char id-start)
+ (setq res 'no-id))
+
(name-res
(cond ((eq name-res t)
;; A normal identifier.
(goto-char id-end)
(if (or res c-promote-possible-types)
(progn
- (c-add-type id-start id-end)
+ (when (not (eq c-promote-possible-types 'just-one))
+ (c-add-type id-start (save-excursion
+ (goto-char id-end)
+ (c-backward-syntactic-ws)
+ (point))))
(when (and c-record-type-identifiers id-range)
(c-record-type-id id-range))
(unless res
@@ -9189,7 +9241,11 @@ multi-line strings (but not C++, for example)."
(t
;; Otherwise it's an operator identifier, which is not a type.
(goto-char start)
- (setq res nil)))))
+ (setq res nil))))
+
+ ((eq res 'prefix)
+ ;; Deal with "extern "C" foo_t my_foo;"
+ (setq res nil)))
(when (not (memq res '(nil no-id)))
;; Skip trailing type modifiers. If any are found we know it's
@@ -9676,7 +9732,7 @@ point unchanged and return nil."
;; (e.g. "," or ";" or "}").
(let ((here (point))
id-start id-end brackets-after-id paren-depth decorated
- got-init arglist)
+ got-init arglist double-double-quote)
(or limit (setq limit (point-max)))
(if (and
(< (point) limit)
@@ -9705,6 +9761,10 @@ point unchanged and return nil."
(setq id-start (point))
(if (looking-at c-overloadable-operators-regexp)
(progn
+ (when (and (c-major-mode-is 'c++-mode)
+ (eq (char-after) ?\")
+ (eq (char-after (1+ (point))) ?\"))
+ (setq double-double-quote t))
(goto-char (match-end 0))
(c-forward-syntactic-ws limit)
(setq got-identifier t)
@@ -9756,6 +9816,13 @@ point unchanged and return nil."
t)
(t nil)))
+ (progn
+ (c-forward-syntactic-ws limit)
+ (when (and double-double-quote ; C++'s operator"" _tag
+ (c-on-identifier))
+ (c-forward-token-2 1 nil limit))
+ t)
+
;; Skip out of the parens surrounding the identifier. If closing
;; parens are missing, this form returns nil.
(or (= paren-depth 0)
@@ -9966,9 +10033,11 @@ This function might do hidden buffer changes."
got-suffix-after-parens id-start
paren-depth 0))
- (if (setq at-type (if (eq backup-at-type 'prefix)
- t
- backup-at-type))
+ (if (not (memq
+ (setq at-type (if (eq backup-at-type 'prefix)
+ t
+ backup-at-type))
+ '(nil no-id)))
(setq type-start backup-type-start
id-start backup-id-start)
(setq type-start start-pos
@@ -9986,7 +10055,8 @@ This function might do hidden buffer changes."
;; This identifier is bound only in the inner let.
'(setq start id-start))))
-(defun c-forward-decl-or-cast-1 (preceding-token-end context last-cast-end)
+(defun c-forward-decl-or-cast-1 (preceding-token-end context last-cast-end
+ &optional inside-macro)
;; Move forward over a declaration or a cast if at the start of one.
;; The point is assumed to be at the start of some token. Nil is
;; returned if no declaration or cast is recognized, and the point
@@ -10075,6 +10145,10 @@ This function might do hidden buffer changes."
;; matched. In that case it's used to discover chains of casts like
;; "(a) (b) c".
;;
+ ;; INSIDE-MACRO is t when we definitely know we're inside a macro, nil
+ ;; otherwise. We use it to disambiguate things like "(a) (b);", which is
+ ;; likely a function call in a macro, but a cast outside of one.
+ ;;
;; This function records identifier ranges on
;; `c-record-type-identifiers' and `c-record-ref-identifiers' if
;; `c-record-type-identifiers' is non-nil.
@@ -10157,7 +10231,11 @@ This function might do hidden buffer changes."
(save-rec-ref-ids c-record-ref-identifiers)
;; Set when we parse a declaration which might also be an expression,
;; such as "a *b". See CASE 16 and CASE 17.
- maybe-expression)
+ maybe-expression
+ ;; Set for the type when `c-forward-type' returned `maybe', and we
+ ;; want to fontify it as a type, but aren't confident enough to enter
+ ;; it into `c-found-types'.
+ unsafe-maybe)
(save-excursion
(goto-char preceding-token-end)
@@ -10718,12 +10796,28 @@ This function might do hidden buffer changes."
((eq at-decl-or-cast t)
(throw 'at-decl-or-cast t))
((and c-has-bitfields
- (eq at-decl-or-cast 'ids)) ; bitfield.
+ ;; Check for a bitfield.
+ (eq at-decl-or-cast 'ids)
+ (save-excursion
+ (forward-char) ; Over the :
+ (c-forward-syntactic-ws)
+ (and (looking-at "[[:alnum:]]")
+ (progn (c-forward-token-2)
+ (c-forward-syntactic-ws)
+ (memq (char-after) '(?\; ?,))))))
(setq backup-if-not-cast t)
(throw 'at-decl-or-cast t)))
- (setq backup-if-not-cast t)
- (throw 'at-decl-or-cast t)))
+ ;; If we're in declaration or template delimiters, or one
+ ;; of a certain set of characters follows, we've got a
+ ;; type and variable.
+ (if (or (memq context '(decl <>))
+ (memq (char-after) '(?\; ?, ?= ?\( ?{ ?:)))
+ (progn
+ (setq backup-if-not-cast t)
+ (throw 'at-decl-or-cast t))
+ ;; We're probably just typing a statement.
+ (throw 'at-decl-or-cast nil))))
;; CASE 4
(when (and got-suffix
@@ -10839,8 +10933,13 @@ This function might do hidden buffer changes."
;; CASE 10
(when at-decl-or-cast
- ;; By now we've located the type in the declaration that we know
- ;; we're in.
+ ;; By now we've located the type in the declaration that we think
+ ;; we're in. Do we have enough evidence to promote the putative
+ ;; type to a found type? The user may be halfway through typing
+ ;; a statement beginning with an identifier.
+ (when (and (eq at-type 'maybe)
+ (not (eq context 'top)))
+ (setq unsafe-maybe t))
(throw 'at-decl-or-cast t))
;; CASE 11
@@ -11003,6 +11102,11 @@ This function might do hidden buffer changes."
;; `got-parens' or `got-suffix' is set it's "a()", "a[]", "a()[]",
;; or similar, which we accept only if the context rules out
;; expressions.
+ ;;
+ ;; If we've got at-type 'maybe, we cannot confidently promote the
+ ;; possible type to a found type.
+ (when (and (eq at-type 'maybe))
+ (setq unsafe-maybe t))
(throw 'at-decl-or-cast t)))
;; If we had a complete symbol table here (which rules out
@@ -11046,11 +11150,17 @@ This function might do hidden buffer changes."
;; Check if the expression begins with a prefix keyword.
(match-beginning 2)
(if (match-beginning 1)
- ;; Expression begins with an ambiguous operator. Treat
- ;; it as a cast if it's a type decl or if we've
- ;; recognized the type somewhere else.
- (or at-decl-or-cast
- (memq at-type '(t known found)))
+ ;; Expression begins with an ambiguous operator.
+ (cond
+ ((match-beginning c-per-&*+--match)
+ (memq at-type '(t known found)))
+ ((match-beginning c-per-++---match)
+ t)
+ ((match-beginning c-per-\(-match)
+ (or
+ (memq at-type '(t known found))
+ (not inside-macro)))
+ (t nil))
;; Unless it's a keyword, it's the beginning of a primary
;; expression.
(not (looking-at c-keywords-regexp)))))
@@ -11076,15 +11186,33 @@ This function might do hidden buffer changes."
;; surrounding parens).
(looking-at c-simple-stmt-key)
(and
- ;; Check that it isn't a close paren (block close is ok,
- ;; though).
- (not (memq (char-before) '(?\) ?\])))
+ ;; Check that it isn't a close paren (block close , or a
+ ;; macro arglist is ok, though).
+ (or
+ (not (memq (char-before) '(?\) ?\])))
+ ;; Have we moved back to a macro arglist?
+ (and c-opt-cpp-prefix
+ (eq (char-before) ?\))
+ (save-excursion
+ (and
+ (c-go-list-backward)
+ (let (pos)
+ (c-backward-syntactic-ws)
+ (and (setq pos (c-on-identifier))
+ (goto-char pos)))
+ (zerop (c-backward-token-2 2))
+ (looking-at c-opt-cpp-macro-define-start)))))
+
;; Check that it isn't a nonsymbol identifier.
(not (c-on-identifier)))))))))
;; Handle the cast.
- (when (and c-record-type-identifiers at-type (not (eq at-type t)))
- (let ((c-promote-possible-types t))
+ (when (and c-record-type-identifiers
+ at-type
+ (not (eq at-type t)))
+ (let ((c-promote-possible-types (if (eq at-type 'maybe)
+ 'just-one
+ t)))
(goto-char type-start)
(c-forward-type)))
@@ -11114,12 +11242,14 @@ This function might do hidden buffer changes."
;; Record the type's coordinates in `c-record-type-identifiers' for
;; later fontification.
- (when (and c-record-type-identifiers at-type ;; (not (eq at-type t))
+ (when (and c-record-type-identifiers
+ (not (memq at-type '(nil no-id)))
;; There seems no reason to exclude a token from
;; fontification just because it's "a known type that can't
;; be a name or other expression". 2013-09-18.
)
- (let ((c-promote-possible-types t))
+ (let ((c-promote-possible-types
+ (if unsafe-maybe 'just-one t)))
(save-excursion
(goto-char type-start)
(c-forward-type))))
@@ -12496,7 +12626,7 @@ comment at the start of cc-engine.el for more info."
(defun c-laomib-fix-elt (lwm elt paren-state)
;; Correct a c-laomib-cache entry ELT with respect to buffer changes, either
- ;; doing nothing, signalling it is to be deleted, or replacing its start
+ ;; doing nothing, signaling it is to be deleted, or replacing its start
;; point with one lower in the buffer than LWM. PAREN-STATE is the paren
;; state at LWM. Return the corrected entry, or nil (if it needs deleting).
;; Note that corrections are made by `setcar'ing the original structure,
diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el
index 2e71285cb3..9444828a0e 100644
--- a/lisp/progmodes/cc-fonts.el
+++ b/lisp/progmodes/cc-fonts.el
@@ -1,4 +1,4 @@
-;;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*-
+;; cc-fonts.el --- font lock support for CC Mode -*- lexical-binding: t -*-
;; Copyright (C) 2002-2022 Free Software Foundation, Inc.
@@ -115,6 +115,7 @@
;; used for preprocessor directives.
'font-lock-builtin-face)
((and (c-face-name-p 'font-lock-reference-face)
+ (boundp 'font-lock-reference-face)
(eq font-lock-reference-face 'font-lock-reference-face))
'font-lock-reference-face)
(t 'font-lock-constant-face)))
@@ -128,6 +129,7 @@
;; suite.)
'font-lock-label-face)
((and (c-face-name-p 'font-lock-constant-face)
+ (boundp 'font-lock-constant-face)
(eq font-lock-constant-face 'font-lock-constant-face))
;; Test both if font-lock-constant-face exists and that it's
;; not an alias for something else. This is important since
@@ -138,20 +140,24 @@
(defconst c-constant-face-name
(if (and (c-face-name-p 'font-lock-constant-face)
+ (boundp 'font-lock-constant-face)
(eq font-lock-constant-face 'font-lock-constant-face))
;; This doesn't exist in some earlier versions of XEmacs 21.
'font-lock-constant-face
c-label-face-name))
(defconst c-reference-face-name
- (with-no-warnings
- (if (and (c-face-name-p 'font-lock-reference-face)
- (eq font-lock-reference-face 'font-lock-reference-face))
- ;; This is considered obsolete in Emacs, but it still maps well
- ;; to this use. (Another reason to do this is to get unique
- ;; faces for the test suite.)
- 'font-lock-reference-face
- c-label-face-name)))
+ (cond
+ ((and (c-face-name-p 'font-lock-reference-face)
+ (boundp 'font-lock-reference-face)
+ (eq font-lock-reference-face 'font-lock-reference-face))
+ ;; This is considered obsolete in Emacs, but it still maps well
+ ;; to this use. (Another reason to do this is to get unique
+ ;; faces for the test suite.)
+ 'font-lock-reference-face)
+ ((c-face-name-p 'font-lock-constant-face)
+ 'font-lock-constant-face)
+ (t c-label-face-name)))
;; This should not mapped to a face that also is used to fontify things
;; that aren't comments or string literals.
@@ -586,7 +592,8 @@ stuff. Used on level 1 and higher."
(c-lang-const c-opt-cpp-macro-define)
(c-lang-const c-nonempty-syntactic-ws)
"\\(" (c-lang-const ; 1 + ncle + nsws
- c-symbol-key) "\\)"
+ c-symbol-key)
+ "\\)"
(concat "\\(" ; 2 + ncle + nsws + c-sym-key
;; Macro with arguments - a "function".
"\\((\\)" ; 3 + ncle + nsws + c-sym-key
@@ -1141,12 +1148,28 @@ casts and declarations are fontified. Used on level 2
and higher."
(while (and (< (point) id-end)
(re-search-forward c-opt-identifier-prefix-key
id-end t))
(c-forward-syntactic-ws limit))))
- (when (not (get-text-property (point) 'face))
+ ;; Only apply the face when the text doesn't have one yet.
+ ;; Exception: The "" in C++'s operator"" will already wrongly have
+ ;; string face.
+ (when (memq (get-text-property (point) 'face)
+ '(nil font-lock-string-face))
(c-put-font-lock-face (point) id-end
(cond
((not (memq types '(nil t))) types)
(is-function 'font-lock-function-name-face)
- (t 'font-lock-variable-name-face))))))
+ (t 'font-lock-variable-name-face))))
+ ;; Fontify any _tag in C++'s operator"" _tag.
+ (when (and
+ (c-major-mode-is 'c++-mode)
+ (equal (buffer-substring-no-properties id-start id-end)
+ "\"\""))
+ (goto-char id-end)
+ (c-forward-syntactic-ws limit)
+ (when (c-on-identifier)
+ (c-put-font-lock-face
+ (point)
+ (progn (c-forward-over-token) (point))
+ font-lock-function-name-face)))))
(and template-class
(eq init-char ?=) ; C++ "<class X = Y>"?
(progn
@@ -1181,135 +1204,159 @@ casts and declarations are fontified. Used on level
2 and higher."
;; arguments lists (i.e. lists enclosed by <...>) is more strict about what
;; characters it allows within the list.
(let ((type (and (> match-pos (point-min))
- (c-get-char-property (1- match-pos) 'c-type))))
- (cond ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?< ?{)))
- (cons (and toplev 'top) nil))
- ;; A control flow expression or a decltype
- ((and (eq (char-before match-pos) ?\()
- (save-excursion
- (goto-char match-pos)
- (backward-char)
- (c-backward-token-2)
- (cond
- ((looking-at c-paren-stmt-key)
- ;; Allow comma separated <> arglists in for statements.
- (cons nil nil))
- ((or (looking-at c-block-stmt-2-key)
- (looking-at c-block-stmt-1-2-key)
- (looking-at c-typeof-key))
- (cons nil t))
- (t nil)))))
- ;; Near BOB.
- ((<= match-pos (point-min))
- (cons 'arglist t))
- ;; Got a cached hit in a declaration arglist.
- ((eq type 'c-decl-arg-start)
- (cons 'decl nil))
- ;; We're inside (probably) a brace list.
- ((eq type 'c-not-decl)
- (cons 'not-decl nil))
- ;; Inside a C++11 lambda function arglist.
- ((and (c-major-mode-is 'c++-mode)
- (eq (char-before match-pos) ?\()
- (save-excursion
- (goto-char match-pos)
- (c-backward-token-2)
- (and
- (c-safe (goto-char (scan-sexps (point) -1)))
- (c-looking-at-c++-lambda-capture-list))))
- (c-put-char-property (1- match-pos) 'c-type
- 'c-decl-arg-start)
- (cons 'decl nil))
- ;; We're inside a brace list.
- ((and (eq (char-before match-pos) ?{)
- (c-inside-bracelist-p (1- match-pos)
- (cdr (c-parse-state))
- nil))
- (c-put-char-property (1- match-pos) 'c-type
- 'c-not-decl)
- (cons 'not-decl nil))
- ;; We're inside an "ordinary" open brace.
- ((eq (char-before match-pos) ?{)
- (cons (and toplev 'top) nil))
- ;; Inside an angle bracket arglist.
- ((or (eq type 'c-<>-arg-sep)
- (eq (char-before match-pos) ?<))
- (cons '<> nil))
- ;; Got a cached hit in some other type of arglist.
- (type
- (cons 'arglist t))
- ;; We're at a C++ uniform initialization.
- ((and (c-major-mode-is 'c++-mode)
- (eq (char-before match-pos) ?\()
- (save-excursion
- (goto-char match-pos)
- (and
- (zerop (c-backward-token-2 2))
- (looking-at c-identifier-start)
- (c-got-face-at (point)
- '(font-lock-variable-name-face)))))
- (cons 'not-decl nil))
- ((and not-front-decl
+ (c-get-char-property (1- match-pos) 'c-type)))
+ id-pos)
+ (cond
+ ;; Are we just after something like "(foo((bar))" ?
+ ((and (eq (char-before match-pos) ?\))
+ (c-go-list-backward match-pos)
+ (progn
+ (c-backward-syntactic-ws)
+ (and (setq id-pos (c-on-identifier))
+ (goto-char id-pos)
+ (progn
+ (c-backward-syntactic-ws)
+ (eq (char-before) ?\()))))
+ (c-get-fontification-context (point) not-front-decl toplev))
+ ((not (memq (char-before match-pos) '(?\( ?, ?\[ ?< ?{)))
+ (cons (and toplev 'top) nil))
+ ;; A control flow expression or a decltype
+ ((and (eq (char-before match-pos) ?\()
+ (save-excursion
+ (goto-char match-pos)
+ (backward-char)
+ (c-backward-token-2)
+ (cond
+ ((looking-at c-paren-stmt-key)
+ ;; Allow comma separated <> arglists in for statements.
+ (cons nil nil))
+ ((or (looking-at c-block-stmt-2-key)
+ (looking-at c-block-stmt-1-2-key)
+ (looking-at c-typeof-key))
+ (cons nil t))
+ (t nil)))))
+ ;; Near BOB.
+ ((<= match-pos (point-min))
+ (cons 'arglist t))
+ ;; Got a cached hit in a declaration arglist.
+ ((eq type 'c-decl-arg-start)
+ (cons 'decl nil))
+ ;; We're inside (probably) a brace list.
+ ((eq type 'c-not-decl)
+ (cons 'not-decl nil))
+ ;; Inside a C++11 lambda function arglist.
+ ((and (c-major-mode-is 'c++-mode)
+ (eq (char-before match-pos) ?\()
+ (save-excursion
+ (goto-char match-pos)
+ (c-backward-token-2)
+ (and
+ (c-safe (goto-char (scan-sexps (point) -1)))
+ (c-looking-at-c++-lambda-capture-list))))
+ (c-put-char-property (1- match-pos) 'c-type
+ 'c-decl-arg-start)
+ (cons 'decl nil))
+ ;; We're inside a brace list.
+ ((and (eq (char-before match-pos) ?{)
+ (c-inside-bracelist-p (1- match-pos)
+ (cdr (c-parse-state))
+ nil))
+ (c-put-char-property (1- match-pos) 'c-type
+ 'c-not-decl)
+ (cons 'not-decl nil))
+ ;; We're inside an "ordinary" open brace.
+ ((eq (char-before match-pos) ?{)
+ (cons (and toplev 'top) nil))
+ ;; Inside an angle bracket arglist.
+ ((or (eq type 'c-<>-arg-sep)
+ (eq (char-before match-pos) ?<))
+ (cons '<> nil))
+ ;; Got a cached hit in some other type of arglist.
+ (type
+ (cons 'arglist t))
+ ;; We're at a C++ uniform initialization.
+ ((and (c-major-mode-is 'c++-mode)
+ (eq (char-before match-pos) ?\()
+ (save-excursion
+ (goto-char match-pos)
+ (and
+ (zerop (c-backward-token-2 2))
+ (looking-at c-identifier-start)
+ (c-got-face-at (point)
+ '(font-lock-variable-name-face)))))
+ (cons 'not-decl nil))
+ ((and not-front-decl
;; The point is within the range of a previously
;; encountered type decl expression, so the arglist
;; is probably one that contains declarations.
;; However, if `c-recognize-paren-inits' is set it
;; might also be an initializer arglist.
- (or (not c-recognize-paren-inits)
- (save-excursion
- (goto-char match-pos)
- (not (c-back-over-member-initializers)))))
- ;; The result of this check is cached with a char
- ;; property on the match token, so that we can look
- ;; it up again when refontifying single lines in a
- ;; multiline declaration.
- (c-put-char-property (1- match-pos)
- 'c-type 'c-decl-arg-start)
- (cons 'decl nil))
- ;; Got (an) open paren(s) preceded by an arith operator.
- ((and (eq (char-before match-pos) ?\()
- (save-excursion
- (goto-char match-pos)
- (while
- (and (zerop (c-backward-token-2))
- (eq (char-after) ?\()))
- (looking-at c-arithmetic-op-regexp)))
- (cons nil nil))
- ;; In a C++ member initialization list.
- ((and (eq (char-before match-pos) ?,)
- (c-major-mode-is 'c++-mode)
- (save-excursion
- (goto-char match-pos)
- (c-back-over-member-initializers)))
- (c-put-char-property (1- match-pos) 'c-type 'c-not-decl)
- (cons 'not-decl nil))
- ;; At start of a declaration inside a declaration paren.
- ((save-excursion
+ (or (not c-recognize-paren-inits)
+ (save-excursion
+ (goto-char match-pos)
+ (not (c-back-over-member-initializers)))))
+ ;; The result of this check is cached with a char
+ ;; property on the match token, so that we can look
+ ;; it up again when refontifying single lines in a
+ ;; multiline declaration.
+ (c-put-char-property (1- match-pos)
+ 'c-type 'c-decl-arg-start)
+ (cons 'decl nil))
+ ;; Got (an) open paren(s) preceded by an arith operator.
+ ((and (eq (char-before match-pos) ?\()
+ (save-excursion
(goto-char match-pos)
- (and (memq (char-before match-pos) '(?\( ?\,))
- (c-go-up-list-backward match-pos
- ; c-determine-limit is too slow, here.
- (max (- (point) 2000) (point-min)))
- (eq (char-after) ?\()
- (let ((type (c-get-char-property (point) 'c-type)))
- (or (memq type '(c-decl-arg-start c-decl-type-start))
- (and
- (progn (c-backward-syntactic-ws) t)
- (or
- (and
- (c-back-over-compound-identifier)
- (progn
- (c-backward-syntactic-ws)
- (or (bobp)
- (progn
- (setq type (c-get-char-property (1- (point))
- 'c-type))
- (memq type '(c-decl-arg-start
- c-decl-type-start))))))
- (and (zerop (c-backward-token-2))
- (looking-at c-fun-name-substitute-key))))))))
- (cons 'decl nil))
- (t (cons 'arglist t)))))
+ (while
+ (and (zerop (c-backward-token-2))
+ (eq (char-after) ?\()))
+ (looking-at c-arithmetic-op-regexp)))
+ (cons nil nil))
+ ;; In a C++ member initialization list.
+ ((and (eq (char-before match-pos) ?,)
+ (c-major-mode-is 'c++-mode)
+ (save-excursion
+ (goto-char match-pos)
+ (c-back-over-member-initializers)))
+ (c-put-char-property (1- match-pos) 'c-type 'c-not-decl)
+ (cons 'not-decl nil))
+ ;; At start of a declaration inside a declaration paren.
+ ((save-excursion
+ (goto-char match-pos)
+ (and (memq (char-before match-pos) '(?\( ?\,))
+ (c-go-up-list-backward match-pos
+ ; c-determine-limit is too slow, here.
+ (max (- (point) 2000) (point-min)))
+ (eq (char-after) ?\()
+ (let ((type (c-get-char-property (point) 'c-type)))
+ (or (memq type '(c-decl-arg-start c-decl-type-start))
+ (progn
+ (c-backward-syntactic-ws)
+ (cond
+ ((and toplev
+ (eq (char-before) ?\)))
+ (save-excursion
+ (and (c-go-list-backward nil (max (- (point) 2000)
+ (point-min)))
+ (eq (char-after) ?\()
+ (progn (c-backward-syntactic-ws)
+ (c-back-over-compound-identifier)))))
+ ((save-excursion
+ (and
+ (c-back-over-compound-identifier)
+ (progn
+ (c-backward-syntactic-ws)
+ (or (bobp)
+ (progn
+ (setq type (c-get-char-property (1- (point))
+ 'c-type))
+ (memq type '(c-decl-arg-start
+ c-decl-type-start))))))))
+ ((and (zerop (c-backward-token-2))
+ (looking-at c-fun-name-substitute-key)))))))))
+ ;; Cache the result of this test for next time around.
+ (c-put-char-property (1- match-pos) 'c-type 'c-decl-arg-start)
+ (cons 'decl nil))
+ (t (cons 'arglist t)))))
(defun c-font-lock-single-decl (limit decl-or-cast match-pos context toplev)
;; Try to fontify a single declaration, together with all its declarators.
@@ -1549,7 +1596,7 @@ casts and declarations are fontified. Used on level 2
and higher."
nil)
(setq decl-or-cast
(c-forward-decl-or-cast-1
- match-pos context last-cast-end))
+ match-pos context last-cast-end inside-macro))
;; Ensure that c-<>-arg-sep c-type properties are in place
on the
;; commas separating the arguments inside template/generic
<..>s.
diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el
index cd23483a58..561aa0f7e5 100644
--- a/lisp/progmodes/cc-langs.el
+++ b/lisp/progmodes/cc-langs.el
@@ -93,7 +93,7 @@
;; definitions (i.e. this file and/or cc-fonts.el) if necessary.
;;
;; A small example of a derived mode is available at
-;; <http://cc-mode.sourceforge.net/derived-mode-ex.el>. It also
+;; <https://cc-mode.sourceforge.net/derived-mode-ex.el>. It also
;; contains some useful hints for derived mode developers.
;;; Using language variables:
@@ -1449,8 +1449,7 @@ form\". See also `c-op-identifier-prefix'."
"??'=" "xor_eq" "&=" "and_eq" "|=" "??!=" "or_eq"
"<<" ">>" ">>=" "<<=" "==" "!=" "not_eq" "<=>" "<=" ">="
"&&" "and" "||" "??!??!" "or" "++" "--" "," "->*" "->"
- "()" "[]" "<::>" "??(??)")
- ;; These work like identifiers in Pike.
+ "()" "[]" "\"\"" "<::>" "??(??)")
pike '("`+" "`-" "`&" "`|" "`^" "`<<" "`>>" "`*" "`/" "`%" "`~"
"`==" "`<" "`>" "`!" "`[]" "`[]=" "`->" "`->=" "`()" "``+"
"``-" "``&" "``|" "``^" "``<<" "``>>" "``*" "``/" "``%"
@@ -2295,11 +2294,22 @@ declaration with a type as a default value. This is
used only in
C++ Mode, e.g. \"<typename X = Y>\"."
t nil
c++ '("class" "typename"))
-
(c-lang-defconst c-template-typename-key
t (c-make-keywords-re t (c-lang-const c-template-typename-kwds)))
(c-lang-defvar c-template-typename-key (c-lang-const c-template-typename-key))
+(c-lang-defconst c-self-contained-typename-kwds
+ "Keywords where the following name is a type name which can be
+used in declarations without the keyword."
+ t nil
+ c++ '("typename"))
+
+(c-lang-defconst c-self-contained-typename-key
+ ;; Adorned regexp matching `c-self-contained-typename-key'.
+ t (c-make-keywords-re t (c-lang-const c-self-contained-typename-kwds)))
+(c-lang-defvar c-self-contained-typename-key
+ (c-lang-const c-self-contained-typename-key))
+
(c-lang-defconst c-type-prefix-kwds
"Keywords where the following name - if any - is a type name, and
where the keyword together with the symbol works as a type in
@@ -2309,7 +2319,7 @@ Note that an alternative if the second part doesn't hold
is
`c-type-list-kwds'. Keywords on this list are typically also present
on one of the `*-decl-kwds' lists."
t nil
- c '("struct" "union" "enum")
+ (c objc) '("struct" "union" "enum")
c++ (append '("class" "typename")
(c-lang-const c-type-prefix-kwds c)))
@@ -2703,7 +2713,7 @@ before the type, so such things are not necessary to
mention here.
Mentioning them here is necessary only if they can occur in other
places, or if they are followed by a construct that must be skipped
over (like the parens in the \"__attribute__\" and \"__declspec\"
-examples above). In the last case, they alse need to be present on
+examples above). In the last case, they also need to be present on
one of `c-type-list-kwds', `c-ref-list-kwds',
`c-colon-type-list-kwds', `c-paren-nontype-kwds', `c-paren-type-kwds',
`c-<>-type-kwds', or `c-<>-arglist-kwds'."
@@ -2936,6 +2946,15 @@ regexp if `c-colon-type-list-kwds' isn't nil."
"[^][{}();,/#=:]*:")))
(c-lang-defvar c-colon-type-list-re (c-lang-const c-colon-type-list-re))
+(c-lang-defconst c-sub-colon-type-list-re
+ "Regexp matching buffer content that may come between a keyword in
+`c-colon-type-list-kwds' and a putative colon, or nil if there are no
+such keywords. Exception: it does not match any C++ attributes."
+ t (if (c-lang-const c-colon-type-list-re)
+ (substring (c-lang-const c-colon-type-list-re) 0 -1)))
+(c-lang-defvar c-sub-colon-type-list-re
+ (c-lang-const c-sub-colon-type-list-re))
+
(c-lang-defconst c-paren-nontype-kwds
"Keywords that may be followed by a parenthesis expression that doesn't
contain type identifiers."
@@ -3470,76 +3489,179 @@ Note that Java specific rules are currently applied to
tell this from
(c-lang-defvar c-regular-keywords-regexp
(c-lang-const c-regular-keywords-regexp))
-(c-lang-defconst c-primary-expr-regexp
- ;; Regexp matching the start of any primary expression, i.e. any
- ;; literal, symbol, prefix operator, and '('. It doesn't need to
- ;; exclude keywords; they are excluded afterwards unless the second
- ;; submatch matches. If the first but not the second submatch
- ;; matches then it is an ambiguous primary expression; it could also
- ;; be a match of e.g. an infix operator. (The case with ambiguous
- ;; keyword operators isn't handled.)
-
+(c-lang-defconst c-primary-expr-regexp-details
+ ;; A list of c-primary-expr-regexp and three numbers identifying particular
+ ;; matches in it.
t (let* ((prefix-ops
+ ;All prefix ops
(c-filter-ops (c-lang-const c-operators)
'(prefix)
(lambda (op)
;; Filter out the special case prefix
;; operators that are close parens.
(not (string-match "\\s)" op)))))
-
- (nonkeyword-prefix-ops
- (c-filter-ops prefix-ops
- t
- "\\`\\(\\s.\\|\\s(\\|\\s)\\)+\\'"))
+ (postfix-ops
+ ;; All postfix ops.
+ (c-filter-ops (c-lang-const c-operators)
+ '(postfix)
+ (lambda (op) (not (string-match "\\s)" op)))))
(in-or-postfix-ops
+ ;; All ops which are postfix, etc.
(c-filter-ops (c-lang-const c-operators)
'(postfix
postfix-if-paren
left-assoc
right-assoc
right-assoc-sequence)
- t)))
+ t))
- (concat
- "\\("
- ;; Take out all symbol class operators from `prefix-ops' and make the
- ;; first submatch from them together with `c-primary-expr-kwds'.
- (c-make-keywords-re t
- (append (c-lang-const c-primary-expr-kwds)
- (c--set-difference prefix-ops nonkeyword-prefix-ops
- :test 'string-equal)))
-
- "\\|"
- ;; Match all ambiguous operators.
- (c-make-keywords-re nil
- (c--intersection nonkeyword-prefix-ops in-or-postfix-ops
- :test 'string-equal))
- "\\)"
-
- "\\|"
- ;; Now match all other symbols.
- (c-lang-const c-symbol-start)
-
- "\\|"
- ;; The chars that can start integer and floating point
- ;; constants.
- "\\.?[0-9]"
-
- "\\|"
- ;; The unambiguous operators from `prefix-ops'.
- (c-make-keywords-re nil
- (c--set-difference nonkeyword-prefix-ops in-or-postfix-ops
- :test 'string-equal))
-
- "\\|"
- ;; Match string and character literals.
- "\\s\""
- (if (memq 'gen-string-delim c-emacs-features)
- "\\|\\s|"
- ""))))
+ (nonkeyword-prefix-ops
+ ;; All prefix ops apart from those which are keywords.
+ (c-filter-ops prefix-ops
+ t
+ "\\`\\(\\s.\\|\\s(\\|\\s)\\)+\\'"))
+ (nonkeyword-postfix-ops
+ ;; All postfix ops apart from those which are keywords.
+ (c-filter-ops postfix-ops
+ t
+ "\\`\\(\\s.\\|\\s(\\|\\s)\\)+\\'"))
+
+ (cast-ops
+ ;; All prefix ops which have syntax open-paren.
+ (c-filter-ops prefix-ops
+ t
+ "\\`\\s(\\'"))
+
+ (ambiguous-pre/postfix-ops
+ ;; All non-keyword ops which are both prefix and postfix, apart
+ ;; from (.
+ (c--set-difference (c--intersection nonkeyword-prefix-ops
+ nonkeyword-postfix-ops
+ :test 'string-equal)
+ cast-ops :test 'string-equal))
+ (unambiguous-prefix-ops
+ ;; All non-keyword ops which are prefix ops and not any other type
+ ;; of op.
+ (c--set-difference nonkeyword-prefix-ops
+ in-or-postfix-ops
+ :test 'string-equal))
+ (ambiguous-prefix-ops
+ ;; All non-keyword ops which are prefix ops and also some other
+ ;; type of op.
+ (c--intersection nonkeyword-prefix-ops
+ in-or-postfix-ops
+ :test 'string-equal)) ; This has everything we
+ ; need, plus (, ++, --.
+
+ (ambiguous-prefix-non-postfix-ops
+ ;; All non-keyword prefix ops which are also other types of ops
+ ;; apart from postfix ops.
+ (c--set-difference (c--set-difference ambiguous-prefix-ops
+ ambiguous-pre/postfix-ops
+ :test 'string-equal)
+ cast-ops :test 'string-equal))
+
+ (primary-expression-keywords-string
+ ;; Take out all symbol class operators from `prefix-ops' and make
+ ;; the first submatch from them together with
+ ;; `c-primary-expr-kwds'.
+ (c-make-keywords-re t
+ (append (c-lang-const c-primary-expr-kwds)
+ (c--set-difference prefix-ops nonkeyword-prefix-ops
+ :test 'string-equal))))
+ (primary-expression-keywords-string-depth
+ (regexp-opt-depth primary-expression-keywords-string))
+
+ (ambiguous-pre/postfix-string
+ (c-make-keywords-re nil ambiguous-pre/postfix-ops))
+ (ambiguous-pre/postfix-string-depth
+ (regexp-opt-depth ambiguous-pre/postfix-string))
+
+ (ambiguous-prefix-non-postfix-string
+ (c-make-keywords-re nil ambiguous-prefix-non-postfix-ops))
+ (ambiguous-prefix-non-postfix-string-depth
+ (regexp-opt-depth ambiguous-prefix-non-postfix-string))
+
+ (per-++---match (+ 2 primary-expression-keywords-string-depth))
+ (per-&*+--match (+ 1 per-++---match
+ ambiguous-pre/postfix-string-depth))
+ (per-\(-match (+ 1 per-&*+--match
+ ambiguous-prefix-non-postfix-string-depth)))
+
+ (list
+ (concat
+ "\\(" ; 1
+ primary-expression-keywords-string
+ "\\|"
+ ;; Match all ambiguous operators.
+ "\\(" ; 2 + primary-expression-keywords-string-depth
+ ambiguous-pre/postfix-string
+ "\\)\\|\\(" ; 3 + primary-expression-keywords-string-depth
+ ; + ambiguous-pre/postfix-string-depth
+ ambiguous-prefix-non-postfix-string
+ "\\)\\|"
+ "\\((\\)" ; 4 + primary-expression-keywords-string-depth
+ ; + ambiguous-pre/postfix-string-depth
+ ; + ambiguous-prefix-non-postfix-string-depth
+ "\\)"
+
+ "\\|"
+ ;; Now match all other symbols.
+ (c-lang-const c-symbol-start)
+
+ "\\|"
+ ;; The chars that can start integer and floating point
+ ;; constants.
+ "\\.?[0-9]"
+
+ "\\|"
+ ;; The unambiguous operators from `prefix-ops'.
+ (c-make-keywords-re nil
+ ;; (c--set-difference nonkeyword-prefix-ops in-or-postfix-ops
+ ;; :test 'string-equal)
+ unambiguous-prefix-ops
+ )
+
+ "\\|"
+ ;; Match string and character literals.
+ "\\s\""
+ (if (memq 'gen-string-delim c-emacs-features)
+ "\\|\\s|"
+ ""))
+ per-++---match
+ per-&*+--match
+ per-\(-match)))
+
+(c-lang-defconst c-primary-expr-regexp
+ ;; Regexp matching the start of any primary expression, i.e. any
+ ;; literal, symbol, prefix operator, and '('. It doesn't need to
+ ;; exclude keywords; they are excluded afterwards unless the second
+ ;; submatch matches. If the first but not the second submatch
+ ;; matches then it is an ambiguous primary expression; it could also
+ ;; be a match of e.g. an infix operator. (The case with ambiguous
+ ;; keyword operators isn't handled.)
+ t (car (c-lang-const c-primary-expr-regexp-details)))
(c-lang-defvar c-primary-expr-regexp (c-lang-const c-primary-expr-regexp))
+(c-lang-defconst c-per-++---match
+ ;; Match number for group in `c-primary-expr-regexp' which matches (in C)
+ ;; the ++ and -- operators, and any similar ones in other languages.
+ t (cadr (c-lang-const c-primary-expr-regexp-details)))
+(c-lang-defvar c-per-++---match (c-lang-const c-per-++---match))
+
+(c-lang-defconst c-per-&*+--match
+ ;; Match number for group in `c-primary-expr-regexp' which matches (in C)
+ ;; the &, *, +, and - operators, and any similar ones in other languages.
+ t (car (cddr (c-lang-const c-primary-expr-regexp-details))))
+(c-lang-defvar c-per-&*+--match (c-lang-const c-per-&*+--match))
+
+(c-lang-defconst c-per-\(-match
+ ;; Match number for group in `c-primary-expr-regexp' which matches (in C)
+ ;; the ( operator, and any similar ones in other languages.
+ t (cadr (cddr (c-lang-const c-primary-expr-regexp-details))))
+(c-lang-defvar c-per-\(-match (c-lang-const c-per-\(-match))
+
;;; Additional constants for parser-level constructs.
@@ -3747,6 +3869,14 @@ possible for good performance."
t)
"\\>")))
+(c-lang-defconst c-maybe-typeless-specifier-re
+ "Regexp matching keywords which might, but needn't, declare variables with
+no explicit type given, or nil in languages without such specifiers."
+ t (c-lang-const c-opt-type-modifier-prefix-key)
+ c (c-lang-const c-type-decl-prefix-keywords-key))
+(c-lang-defvar c-maybe-typeless-specifier-re
+ (c-lang-const c-maybe-typeless-specifier-re))
+
(c-lang-defconst c-type-decl-prefix-key
"Regexp matching any declarator operator that might precede the
identifier in a declaration, e.g. the \"*\" in \"char *argv\". This
diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el
index 2003b09ded..5a610253e0 100644
--- a/lisp/progmodes/cc-mode.el
+++ b/lisp/progmodes/cc-mode.el
@@ -66,12 +66,12 @@
;; You can get the latest version of CC Mode, including PostScript
;; documentation and separate individual files from:
;;
-;; http://cc-mode.sourceforge.net/
+;; https://cc-mode.sourceforge.net/
;;
;; You can join a moderated CC Mode announcement-only mailing list by
;; visiting
;;
-;; http://lists.sourceforge.net/mailman/listinfo/cc-mode-announce
+;; https://lists.sourceforge.net/mailman/listinfo/cc-mode-announce
;; Externally maintained major modes which use CC-mode's engine include:
;; - cuda-mode
@@ -172,7 +172,7 @@
;; `c-font-lock-init' too to set up CC Mode's font lock support.
;;
;; See cc-langs.el for further info. A small example of a derived mode
-;; is also available at <http://cc-mode.sourceforge.net/
+;; is also available at <https://cc-mode.sourceforge.net/
;; derived-mode-ex.el>.
(defun c-leave-cc-mode-mode ()
@@ -1235,7 +1235,7 @@ Note that the style variables are always made local to
the buffer."
(defun c-multiline-string-check-final-quote ()
;; Check that the final quote in the buffer is correctly marked or not with
- ;; a string-fence syntax-table text propery. The return value has no
+ ;; a string-fence syntax-table text property. The return value has no
;; significance.
(let (pos-ll pos-lt)
(save-excursion
@@ -2080,13 +2080,14 @@ with // and /*, not more generic line and block
comments."
(defun c-update-new-id (end)
;; Note the bounds of any identifier that END is in or just after, in
;; `c-new-id-start' and `c-new-id-end'. Otherwise set these variables to
- ;; nil.
+ ;; nil. Set `c-new-id-is-type' unconditionally to nil.
(save-excursion
(goto-char end)
(let ((id-beg (c-on-identifier)))
(setq c-new-id-start id-beg
c-new-id-end (and id-beg
- (progn (c-end-of-current-token) (point)))))))
+ (progn (c-end-of-current-token) (point)))
+ c-new-id-is-type nil))))
(defun c-post-command ()
;; If point was inside of a new identifier and no longer is, record that
@@ -2389,6 +2390,8 @@ with // and /*, not more generic line and block comments."
;; Go to a less nested declaration each time round this loop.
(and
(setq old-pos (point))
+ ;; The following form tries to move to the end of the previous
+ ;; declaration without moving outside of an enclosing {.
(let (pseudo)
(while
(and
@@ -2403,7 +2406,9 @@ with // and /*, not more generic line and block comments."
(setq pseudo (c-cheap-inside-bracelist-p
(c-parse-state)))))))
(goto-char pseudo))
t)
- (>= (point) bod-lim)
+ (or (> (point) bod-lim)
+ (eq bod-lim (point-min)))
+ ;; Move forward to the start of the next declaration.
(progn (c-forward-syntactic-ws)
;; Have we got stuck in a comment at EOB?
(not (and (eobp)
@@ -2500,7 +2505,7 @@ with // and /*, not more generic line and block comments."
(not (eobp)))
(progn
(c-forward-over-token)
- ;; Cope with having POS withing a syntactically invalid
+ ;; Cope with having POS within a syntactically invalid
;; (...), by moving backward out of the parens and trying
;; again.
(when (and (eq (char-before) ?\))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index ded5d2130e..18c996e899 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -175,7 +175,7 @@ and a string describing how the process finished.")
(defvar compilation-num-warnings-found 0)
(defvar compilation-num-infos-found 0)
-(defconst compilation-mode-line-errors
+(defvar compilation-mode-line-errors
'(" [" (:propertize (:eval (int-to-string compilation-num-errors-found))
face compilation-error
help-echo "Number of errors so far")
@@ -980,12 +980,17 @@ Faces `compilation-error-face',
`compilation-warning-face',
"Face name to use for leaving directory messages.")
(defcustom compilation-auto-jump-to-first-error nil
- "If non-nil, automatically jump to the first error during compilation."
+ "If non-nil, automatically jump to the first error during compilation.
+
+The value `if-location-known' means automatically jump to the first error
+if the error's file can be found. The value `first-known' means jump to
+the first error whose file can be found. Any other non-nil value means
+jump to the first error unconditionally."
:type '(choice (const :tag "Never" nil)
(const :tag "Always" t)
(const :tag "If location known" if-location-known)
(const :tag "First known location" first-known))
- :version "23.1")
+ :version "29.1")
(defvar-local compilation-auto-jump-to-next nil
"If non-nil, automatically jump to the next error encountered.")
diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el
index 20a73e238e..b36896ae7c 100644
--- a/lisp/progmodes/cperl-mode.el
+++ b/lisp/progmodes/cperl-mode.el
@@ -1429,10 +1429,40 @@ the last)."
(rx (sequence line-start (0+ blank) (eval cperl--imenu-entries-rx)))
"The regular expression used for `outline-minor-mode'.")
-(defvar cperl-mode-syntax-table nil
+(defvar cperl-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?\\ "\\" st)
+ (modify-syntax-entry ?/ "." st)
+ (modify-syntax-entry ?* "." st)
+ (modify-syntax-entry ?+ "." st)
+ (modify-syntax-entry ?- "." st)
+ (modify-syntax-entry ?= "." st)
+ (modify-syntax-entry ?% "." st)
+ (modify-syntax-entry ?< "." st)
+ (modify-syntax-entry ?> "." st)
+ (modify-syntax-entry ?& "." st)
+ (modify-syntax-entry ?$ "\\" st)
+ (modify-syntax-entry ?\n ">" st)
+ (modify-syntax-entry ?# "<" st)
+ (modify-syntax-entry ?' "\"" st)
+ (modify-syntax-entry ?` "\"" st)
+ (if cperl-under-as-char
+ (modify-syntax-entry ?_ "w" st))
+ (modify-syntax-entry ?: "_" st)
+ (modify-syntax-entry ?| "." st)
+ st)
"Syntax table in use in CPerl mode buffers.")
-(defvar cperl-string-syntax-table nil
+(defvar cperl-string-syntax-table
+ (let ((st (copy-syntax-table cperl-mode-syntax-table)))
+ (modify-syntax-entry ?$ "." st)
+ (modify-syntax-entry ?\{ "." st)
+ (modify-syntax-entry ?\} "." st)
+ (modify-syntax-entry ?\" "." st)
+ (modify-syntax-entry ?' "." st)
+ (modify-syntax-entry ?` "." st)
+ (modify-syntax-entry ?# "." st) ; (?# comment )
+ st)
"Syntax table in use in CPerl mode string-like chunks.")
(defsubst cperl-1- (p)
@@ -1441,38 +1471,6 @@ the last)."
(defsubst cperl-1+ (p)
(min (point-max) (1+ p)))
-(if cperl-mode-syntax-table
- ()
- (setq cperl-mode-syntax-table (make-syntax-table))
- (modify-syntax-entry ?\\ "\\" cperl-mode-syntax-table)
- (modify-syntax-entry ?/ "." cperl-mode-syntax-table)
- (modify-syntax-entry ?* "." cperl-mode-syntax-table)
- (modify-syntax-entry ?+ "." cperl-mode-syntax-table)
- (modify-syntax-entry ?- "." cperl-mode-syntax-table)
- (modify-syntax-entry ?= "." cperl-mode-syntax-table)
- (modify-syntax-entry ?% "." cperl-mode-syntax-table)
- (modify-syntax-entry ?< "." cperl-mode-syntax-table)
- (modify-syntax-entry ?> "." cperl-mode-syntax-table)
- (modify-syntax-entry ?& "." cperl-mode-syntax-table)
- (modify-syntax-entry ?$ "\\" cperl-mode-syntax-table)
- (modify-syntax-entry ?\n ">" cperl-mode-syntax-table)
- (modify-syntax-entry ?# "<" cperl-mode-syntax-table)
- (modify-syntax-entry ?' "\"" cperl-mode-syntax-table)
- (modify-syntax-entry ?` "\"" cperl-mode-syntax-table)
- (if cperl-under-as-char
- (modify-syntax-entry ?_ "w" cperl-mode-syntax-table))
- (modify-syntax-entry ?: "_" cperl-mode-syntax-table)
- (modify-syntax-entry ?| "." cperl-mode-syntax-table)
- (setq cperl-string-syntax-table (copy-syntax-table cperl-mode-syntax-table))
- (modify-syntax-entry ?$ "." cperl-string-syntax-table)
- (modify-syntax-entry ?\{ "." cperl-string-syntax-table)
- (modify-syntax-entry ?\} "." cperl-string-syntax-table)
- (modify-syntax-entry ?\" "." cperl-string-syntax-table)
- (modify-syntax-entry ?' "." cperl-string-syntax-table)
- (modify-syntax-entry ?` "." cperl-string-syntax-table)
- (modify-syntax-entry ?# "." cperl-string-syntax-table)) ; (?# comment )
-
-
(defvar cperl-faces-init nil)
;; Fix for msb.el
@@ -8323,7 +8321,7 @@ the appropriate statement modifier."
'cperl-short-docs
'variable-documentation))))
(Man-switches "")
- (manual-program (if is-func "perldoc -f" "perldoc")))
+ (manual-program (concat "perldoc -i" (if is-func " -f"))))
(Man-getpage-in-background word)))
;;;###autoload
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
index f4584b6311..43e430d40c 100644
--- a/lisp/progmodes/cpp.el
+++ b/lisp/progmodes/cpp.el
@@ -1,6 +1,6 @@
;;; cpp.el --- highlight or hide text according to cpp conditionals -*-
lexical-binding: t -*-
-;; Copyright (C) 1994-1995, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1994-2022 Free Software Foundation, Inc.
;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
;; Keywords: c, faces, tools
@@ -98,8 +98,8 @@ Each entry is a list with the following elements:
(const :tag "Both branches writable" both)))))
(defcustom cpp-message-min-time-interval 1.0
- "Minimum time interval in seconds for `cpp-progress-message' messages.
-If nil, `cpp-progress-message' prints no progress messages."
+ "Minimum time interval in seconds for `cpp-highlight-buffer' progress
messages.
+If nil, `cpp-highlight-buffer' prints no progress messages."
:type '(choice (const :tag "Disable progress messages" nil)
float)
:version "26.1")
@@ -218,14 +218,15 @@ A prefix arg suppresses display of that buffer."
(cpp-parse-reset)
(if (null cpp-edit-list)
(cpp-edit-load))
- (let (cpp-state-stack)
+ (let ((reporter
+ (and cpp-message-min-time-interval
+ (make-progress-reporter "Parsing..." (point-min) (point-max)
+ nil nil cpp-message-min-time-interval)))
+ cpp-state-stack)
(save-excursion
(goto-char (point-min))
- (cpp-progress-message "Parsing...")
(while (re-search-forward cpp-parse-regexp nil t)
- (cpp-progress-message "Parsing...%d%%"
- (floor (* 100.0 (- (point) (point-min)))
- (buffer-size)))
+ (when reporter (progress-reporter-update reporter (point)))
(let ((match (buffer-substring (match-beginning 0) (match-end 0))))
(cond ((or (string-equal match "'")
(string-equal match "\""))
@@ -268,7 +269,7 @@ A prefix arg suppresses display of that buffer."
(cpp-parse-close from to))
(t
(cpp-parse-error "Parser error"))))))))
- (cpp-progress-message "Parsing...done"))
+ (when reporter (progress-reporter-done reporter)))
(if cpp-state-stack
(save-excursion
(goto-char (nth 3 (car cpp-state-stack)))
@@ -410,47 +411,45 @@ A prefix arg suppresses display of that buffer."
;;; Edit Buffer:
-(defvar cpp-edit-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map)
- (define-key map [ down-mouse-2 ] 'cpp-push-button)
- (define-key map [ mouse-2 ] 'ignore)
- (define-key map " " 'scroll-up-command)
- (define-key map [?\S-\ ] 'scroll-down-command)
- (define-key map "\C-?" 'scroll-down-command)
- (define-key map [ delete ] 'scroll-down)
- (define-key map "\C-c\C-c" 'cpp-edit-apply)
- (define-key map "a" 'cpp-edit-apply)
- (define-key map "A" 'cpp-edit-apply)
- (define-key map "r" 'cpp-edit-reset)
- (define-key map "R" 'cpp-edit-reset)
- (define-key map "s" 'cpp-edit-save)
- (define-key map "S" 'cpp-edit-save)
- (define-key map "l" 'cpp-edit-load)
- (define-key map "L" 'cpp-edit-load)
- (define-key map "h" 'cpp-edit-home)
- (define-key map "H" 'cpp-edit-home)
- (define-key map "b" 'cpp-edit-background)
- (define-key map "B" 'cpp-edit-background)
- (define-key map "k" 'cpp-edit-known)
- (define-key map "K" 'cpp-edit-known)
- (define-key map "u" 'cpp-edit-unknown)
- (define-key map "u" 'cpp-edit-unknown)
- (define-key map "t" 'cpp-edit-true)
- (define-key map "T" 'cpp-edit-true)
- (define-key map "f" 'cpp-edit-false)
- (define-key map "F" 'cpp-edit-false)
- (define-key map "w" 'cpp-edit-write)
- (define-key map "W" 'cpp-edit-write)
- (define-key map "X" 'cpp-edit-toggle-known)
- (define-key map "x" 'cpp-edit-toggle-known)
- (define-key map "Y" 'cpp-edit-toggle-unknown)
- (define-key map "y" 'cpp-edit-toggle-unknown)
- (define-key map "q" 'bury-buffer)
- (define-key map "Q" 'bury-buffer)
- map)
- "Keymap for `cpp-edit-mode'.")
-
+(defvar-keymap cpp-edit-mode-map
+ :doc "Keymap for `cpp-edit-mode'."
+ :full t
+ :suppress t
+ "<down-mouse-2>" #'cpp-push-button
+ "<mouse-2>" #'ignore
+ "SPC" #'scroll-up-command
+ "S-SPC" #'scroll-down-command
+ "DEL" #'scroll-down-command
+ "<delete>" #'scroll-down
+ "C-c C-c" #'cpp-edit-apply
+ "a" #'cpp-edit-apply
+ "A" #'cpp-edit-apply
+ "r" #'cpp-edit-reset
+ "R" #'cpp-edit-reset
+ "s" #'cpp-edit-save
+ "S" #'cpp-edit-save
+ "l" #'cpp-edit-load
+ "L" #'cpp-edit-load
+ "h" #'cpp-edit-home
+ "H" #'cpp-edit-home
+ "b" #'cpp-edit-background
+ "B" #'cpp-edit-background
+ "k" #'cpp-edit-known
+ "K" #'cpp-edit-known
+ "u" #'cpp-edit-unknown
+ "U" #'cpp-edit-unknown
+ "t" #'cpp-edit-true
+ "T" #'cpp-edit-true
+ "f" #'cpp-edit-false
+ "F" #'cpp-edit-false
+ "w" #'cpp-edit-write
+ "W" #'cpp-edit-write
+ "X" #'cpp-edit-toggle-known
+ "x" #'cpp-edit-toggle-known
+ "Y" #'cpp-edit-toggle-unknown
+ "y" #'cpp-edit-toggle-unknown
+ "q" #'bury-buffer
+ "Q" #'bury-buffer)
(defvar-local cpp-edit-symbols nil
@@ -816,6 +815,7 @@ Type must be one of the types defined in
`cpp-face-type-list'."
;;; Utilities:
+(make-obsolete-variable 'cpp-progress-time nil "29.1")
(defvar cpp-progress-time 0
"Last time `cpp-progress-message' issued a progress message.")
@@ -825,6 +825,7 @@ Type must be one of the types defined in
`cpp-face-type-list'."
Print messages at most once every `cpp-message-min-time-interval' seconds.
If that option is nil, don't prints messages.
ARGS are the same as for `message'."
+ (declare (obsolete make-progress-reporter "29.1"))
(when cpp-message-min-time-interval
(let ((time (current-time)))
(unless (time-less-p cpp-message-min-time-interval
diff --git a/lisp/progmodes/dcl-mode.el b/lisp/progmodes/dcl-mode.el
index 8f79cdaaab..f1d7f236b9 100644
--- a/lisp/progmodes/dcl-mode.el
+++ b/lisp/progmodes/dcl-mode.el
@@ -1,6 +1,6 @@
;;; dcl-mode.el --- major mode for editing DCL command files -*-
lexical-binding: t; -*-
-;; Copyright (C) 1997, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2022 Free Software Foundation, Inc.
;; Author: Odd Gripenstam <gripenstamol@decus.se>
;; Maintainer: emacs-devel@gnu.org
@@ -258,38 +258,34 @@ See `imenu-generic-expression' for details."
;;; *** Global variables ****************************************************
-(defvar dcl-mode-syntax-table nil
+(defvar dcl-mode-syntax-table
+ (let ((st (make-syntax-table)))
+ (modify-syntax-entry ?! "<" st) ; comment start
+ (modify-syntax-entry ?\n ">" st) ; comment end
+ (modify-syntax-entry ?< "(>" st) ; < and ...
+ (modify-syntax-entry ?> ")<" st) ; > is a matching pair
+ (modify-syntax-entry ?\\ "_" st) ; not an escape
+ st)
"Syntax table used in DCL-buffers.")
-(unless dcl-mode-syntax-table
- (setq dcl-mode-syntax-table (make-syntax-table))
- (modify-syntax-entry ?! "<" dcl-mode-syntax-table) ; comment start
- (modify-syntax-entry ?\n ">" dcl-mode-syntax-table) ; comment end
- (modify-syntax-entry ?< "(>" dcl-mode-syntax-table) ; < and ...
- (modify-syntax-entry ?> ")<" dcl-mode-syntax-table) ; > is a matching pair
- (modify-syntax-entry ?\\ "_" dcl-mode-syntax-table) ; not an escape
-)
-
-
-(defvar dcl-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\e\n" #'dcl-split-line)
- (define-key map "\e\t" #'tempo-complete-tag)
- (define-key map "\e^" #'dcl-delete-indentation)
- (define-key map "\em" #'dcl-back-to-indentation)
- (define-key map "\ee" #'dcl-forward-command)
- (define-key map "\ea" #'dcl-backward-command)
- (define-key map "\e\C-q" #'dcl-indent-command)
- (define-key map "\t" #'dcl-tab)
- (define-key map ":" #'dcl-electric-character)
- (define-key map "F" #'dcl-electric-character)
- (define-key map "f" #'dcl-electric-character)
- (define-key map "E" #'dcl-electric-character)
- (define-key map "e" #'dcl-electric-character)
- (define-key map "\C-c\C-o" #'dcl-set-option)
- (define-key map "\C-c\C-f" #'tempo-forward-mark)
- (define-key map "\C-c\C-b" #'tempo-backward-mark)
- map)
- "Keymap used in DCL-mode buffers.")
+
+(defvar-keymap dcl-mode-map
+ :doc "Keymap used in DCL-mode buffers."
+ "M-RET" #'dcl-split-line
+ "M-TAB" #'tempo-complete-tag
+ "M-^" #'dcl-delete-indentation
+ "M-m" #'dcl-back-to-indentation
+ "M-e" #'dcl-forward-command
+ "M-a" #'dcl-backward-command
+ "C-M-q" #'dcl-indent-command
+ "TAB" #'dcl-tab
+ ":" #'dcl-electric-character
+ "F" #'dcl-electric-character
+ "f" #'dcl-electric-character
+ "E" #'dcl-electric-character
+ "e" #'dcl-electric-character
+ "C-c C-o" #'dcl-set-option
+ "C-c C-f" #'tempo-forward-mark
+ "C-c C-b" #'tempo-backward-mark)
(easy-menu-define dcl-mode-menu dcl-mode-map
"Menu for DCL-mode buffers."
diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el
index 6e42da2d54..36849492be 100644
--- a/lisp/progmodes/ebnf2ps.el
+++ b/lisp/progmodes/ebnf2ps.el
@@ -166,8 +166,6 @@
;;
;; Where setup-ebnf2ps.el should be a file containing:
;;
-;; ;; set load-path if ebnf2ps isn't installed in your Emacs environment
-;; (setq load-path (append (list "/dir/of/ebnf2ps") load-path))
;; (require 'ebnf2ps)
;; ;; insert here your ebnf2ps settings
;; (setq ebnf-terminal-shape 'bevel)
@@ -4284,7 +4282,7 @@ end
(ebnf-eps-header-footer ebnf-eps-footer))
-;; hacked fom `ps-output-string-prim' (ps-print.el)
+;; hacked from `ps-output-string-prim' (ps-print.el)
(defun ebnf-eps-string (string)
(let* ((str string)
(len (length str))
@@ -4405,9 +4403,9 @@ end
(defvar ebnf-nprod 0)
-(defsubst ebnf-message-info (messag)
+(defsubst ebnf-message-info (msg)
(message "%s...%3d%%"
- messag
+ msg
(round (/ (* (setq ebnf-nprod (1+ ebnf-nprod)) 100.0) ebnf-total))))
diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el
new file mode 100644
index 0000000000..bbd902c1c7
--- /dev/null
+++ b/lisp/progmodes/eglot.el
@@ -0,0 +1,3469 @@
+;;; eglot.el --- The Emacs Client for LSP servers -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018-2022 Free Software Foundation, Inc.
+
+;; Version: 1.9
+;; Author: João Távora <joaotavora@gmail.com>
+;; Maintainer: João Távora <joaotavora@gmail.com>
+;; URL: https://github.com/joaotavora/eglot
+;; Keywords: convenience, languages
+;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.14") (flymake "1.2.1")
(project "0.3.0") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23"))
+
+;; This is a GNU ELPA :core package. Avoid adding functionality
+;; that is not available in the version of Emacs recorded above or any
+;; of the package dependencies.
+
+;; 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:
+
+;; Eglot ("Emacs Polyglot") is an Emacs LSP client that stays out of
+;; your way.
+;;
+;; Typing M-x eglot in some source file is often enough to get you
+;; started, if the language server you're looking to use is installed
+;; in your system. Please refer to the manual, available from
+;; https://joaotavora.github.io/eglot/ or from M-x info for more usage
+;; instructions.
+;;
+;; If you wish to contribute changes to Eglot, please do read the user
+;; manual first. Additionally, take the following in consideration:
+
+;; * Eglot's main job is to hook up the information that language
+;; servers offer via LSP to Emacs's UI facilities: Xref for
+;; definition-chasing, Flymake for diagnostics, Eldoc for at-point
+;; documentation, etc. Eglot's job is generally *not* to provide
+;; such a UI itself, though a small number of simple
+;; counter-examples do exist, for example in the `eglot-rename'
+;; command. When a new UI is evidently needed, consider adding a
+;; new package to Emacs, or extending an existing one.
+;;
+;; * Eglot was designed to function with just the UI facilities found
+;; in the latest Emacs core, as long as those facilities are also
+;; available as GNU ELPA :core packages. Historically, a number of
+;; :core packages were added or reworked in Emacs to make this
+;; possible. This principle should be upheld when adding new LSP
+;; features or tweaking existing ones. Design any new facilities in
+;; a way that they could work in the absence of LSP or using some
+;; different protocol, then make sure Eglot can link up LSP
+;; information to it.
+
+;; * There are few Eglot configuration variables. This principle
+;; should also be upheld. If Eglot had these variables, it could be
+;; duplicating configuration found elsewhere, bloating itself up,
+;; and making it generally hard to integrate with the ever growing
+;; set of LSP features and Emacs packages. For instance, this is
+;; why one finds a single variable
+;; `eglot-ignored-server-capabilities' instead of a number of
+;; capability-specific flags, or why customizing the display of
+;; LSP-provided documentation is done via ElDoc's variables, not
+;; Eglot's.
+;;
+;; * Linking up LSP information to other libraries is generally done
+;; in the `eglot--managed-mode' minor mode function, by
+;; buffer-locally setting the other library's variables to
+;; Eglot-specific versions. When deciding what to set the variable
+;; to, the general idea is to choose a good default for beginners
+;; that doesn't clash with Emacs's defaults. The settings are only
+;; in place during Eglot's LSP-enriched tenure over a project. Even
+;; so, some of those decisions will invariably aggravate a minority
+;; of Emacs power users, but these users can use `eglot-stay-out-of'
+;; and `eglot-managed-mode-hook' to adjust things to their
+;; preferences.
+;;
+;; * On occasion, to enable new features, Eglot can have soft
+;; dependencies on popular libraries that are not in Emacs core.
+;; "Soft" means that the dependency doesn't impair any other use of
+;; Eglot beyond that feature. Such is the case of the snippet
+;; functionality, via the Yasnippet package, Markdown formatting of
+;; at-point documentation via the markdown-mode package, and nicer
+;; looking completions when the Company package is used.
+
+;;; Code:
+
+(require 'imenu)
+(require 'cl-lib)
+(require 'project)
+(require 'url-parse)
+(require 'url-util)
+(require 'pcase)
+(require 'compile) ; for some faces
+(require 'warnings)
+(require 'flymake)
+(require 'xref)
+(eval-when-compile
+ (require 'subr-x))
+(require 'jsonrpc)
+(require 'filenotify)
+(require 'ert)
+(require 'array)
+
+;; ElDoc is preloaded in Emacs, so `require'-ing won't guarantee we are
+;; using the latest version from GNU Elpa when we load eglot.el. Use an
+;; heuristic to see if we need to `load' it in Emacs < 28.
+(if (and (< emacs-major-version 28)
+ (not (boundp 'eldoc-documentation-strategy)))
+ (load "eldoc")
+ (require 'eldoc))
+
+;; Similar issue as above for Emacs 26.3 and seq.el.
+(if (< emacs-major-version 27)
+ (load "seq")
+ (require 'seq))
+
+;; forward-declare, but don't require (Emacs 28 doesn't seem to care)
+(defvar markdown-fontify-code-blocks-natively)
+(defvar company-backends)
+(defvar company-tooltip-align-annotations)
+
+
+
+;;; User tweakable stuff
+(defgroup eglot nil
+ "Interaction with Language Server Protocol servers."
+ :prefix "eglot-"
+ :group 'applications)
+
+(defun eglot-alternatives (alternatives)
+ "Compute server-choosing function for `eglot-server-programs'.
+Each element of ALTERNATIVES is a string PROGRAM or a list of
+strings (PROGRAM ARGS...) where program names an LSP server
+program to start with ARGS. Returns a function of one argument.
+When invoked, that function will return a list (ABSPATH ARGS),
+where ABSPATH is the absolute path of the PROGRAM that was
+chosen (interactively or automatically)."
+ (lambda (&optional interactive)
+ ;; JT@2021-06-13: This function is way more complicated than it
+ ;; could be because it accounts for the fact that
+ ;; `eglot--executable-find' may take much longer to execute on
+ ;; remote files.
+ (let* ((listified (cl-loop for a in alternatives
+ collect (if (listp a) a (list a))))
+ (err (lambda ()
+ (error "None of '%s' are valid executables"
+ (mapconcat #'car listified ", ")))))
+ (cond (interactive
+ (let* ((augmented (mapcar (lambda (a)
+ (let ((found (eglot--executable-find
+ (car a) t)))
+ (and found
+ (cons (car a) (cons found (cdr
a))))))
+ listified))
+ (available (remove nil augmented)))
+ (cond ((cdr available)
+ (cdr (assoc
+ (completing-read
+ "[eglot] More than one server executable
available:"
+ (mapcar #'car available)
+ nil t nil nil (car (car available)))
+ available #'equal)))
+ ((cdr (car available)))
+ (t
+ ;; Don't error when used interactively, let the
+ ;; Eglot prompt the user for alternative (github#719)
+ nil))))
+ (t
+ (cl-loop for (p . args) in listified
+ for probe = (eglot--executable-find p t)
+ when probe return (cons probe args)
+ finally (funcall err)))))))
+
+(defvar eglot-server-programs `((rust-mode . ,(eglot-alternatives
'("rust-analyzer" "rls")))
+ (cmake-mode . ("cmake-language-server"))
+ (vimrc-mode . ("vim-language-server"
"--stdio"))
+ (python-mode
+ . ,(eglot-alternatives
+ '("pylsp" "pyls" ("pyright-langserver"
"--stdio") "jedi-language-server")))
+ ((js-json-mode json-mode) .
,(eglot-alternatives '(("vscode-json-language-server" "--stdio")
("json-languageserver" "--stdio"))))
+ ((js-mode ts-mode typescript-mode)
+ . ("typescript-language-server" "--stdio"))
+ (sh-mode . ("bash-language-server" "start"))
+ ((php-mode phps-mode)
+ . ,(eglot-alternatives
+ '(("phpactor" "language-server")
+ ("php"
"vendor/felixfbecker/language-server/bin/php-language-server.php"))))
+ ((c++-mode c-mode) . ,(eglot-alternatives
+ '("clangd" "ccls")))
+ (((caml-mode :language-id "ocaml")
+ (tuareg-mode :language-id "ocaml")
reason-mode)
+ . ("ocamllsp"))
+ (ruby-mode
+ . ("solargraph" "socket" "--port" :autoport))
+ (haskell-mode
+ . ("haskell-language-server-wrapper" "--lsp"))
+ (elm-mode . ("elm-language-server"))
+ (mint-mode . ("mint" "ls"))
+ (kotlin-mode . ("kotlin-language-server"))
+ ((go-mode go-dot-mod-mode go-dot-work-mode) .
("gopls"))
+ ((R-mode ess-r-mode) . ("R" "--slave" "-e"
+
"languageserver::run()"))
+ (java-mode . ("jdtls"))
+ (dart-mode . ("dart" "language-server"
+ "--client-id"
"emacs.eglot-dart"))
+ (elixir-mode . ("language_server.sh"))
+ (ada-mode . ("ada_language_server"))
+ (scala-mode . ("metals-emacs"))
+ (racket-mode . ("racket" "-l"
"racket-langserver"))
+ ((tex-mode context-mode texinfo-mode
bibtex-mode)
+ . ,(eglot-alternatives '("digestif"
"texlab")))
+ (erlang-mode . ("erlang_ls" "--transport"
"stdio"))
+ (yaml-mode . ("yaml-language-server"
"--stdio"))
+ (nix-mode . ,(eglot-alternatives '("nil"
"rnix-lsp")))
+ (gdscript-mode . ("localhost" 6008))
+ ((fortran-mode f90-mode) . ("fortls"))
+ (futhark-mode . ("futhark" "lsp"))
+ (lua-mode . ,(eglot-alternatives
+ '("lua-language-server"
"lua-lsp")))
+ (zig-mode . ("zls"))
+ (css-mode . ,(eglot-alternatives
'(("vscode-css-language-server" "--stdio") ("css-languageserver" "--stdio"))))
+ (html-mode . ,(eglot-alternatives
'(("vscode-html-language-server" "--stdio") ("html-languageserver" "--stdio"))))
+ (dockerfile-mode . ("docker-langserver"
"--stdio"))
+ ((clojure-mode clojurescript-mode
clojurec-mode)
+ . ("clojure-lsp"))
+ (csharp-mode . ("omnisharp" "-lsp"))
+ (purescript-mode .
("purescript-language-server" "--stdio"))
+ ((perl-mode cperl-mode) . ("perl"
"-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run"))
+ (markdown-mode . ("marksman" "server")))
+ "How the command `eglot' guesses the server to start.
+An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE
+identifies the buffers that are to be managed by a specific
+language server. The associated CONTACT specifies how to connect
+to a server for those buffers.
+
+MAJOR-MODE can be:
+
+* In the most common case, a symbol such as `c-mode';
+
+* A list (MAJOR-MODE-SYMBOL :LANGUAGE-ID ID) where
+ MAJOR-MODE-SYMBOL is the aforementioned symbol and ID is a
+ string identifying the language to the server;
+
+* A list combining the previous two alternatives, meaning
+ multiple major modes will be associated with a single server
+ program. This association is such that the same resulting
+ server process will manage buffers of different major modes.
+
+CONTACT can be:
+
+* In the most common case, a list of strings (PROGRAM [ARGS...]).
+ PROGRAM is called with ARGS and is expected to serve LSP requests
+ over the standard input/output channels.
+
+* A list (PROGRAM [ARGS...] :initializationOptions OPTIONS),
+ whereupon PROGRAM is called with ARGS as in the first option,
+ and the LSP \"initializationOptions\" JSON object is
+ constructed from OPTIONS. If OPTIONS is a unary function, it
+ is called with the server instance and should return a JSON
+ object.
+
+* A list (HOST PORT [TCP-ARGS...]) where HOST is a string and
+ PORT is a positive integer for connecting to a server via TCP.
+ Remaining ARGS are passed to `open-network-stream' for
+ upgrading the connection with encryption or other capabilities.
+
+* A list (PROGRAM [ARGS...] :autoport [MOREARGS...]), whereupon a
+ combination of previous options is used. First, an attempt is
+ made to find an available server port, then PROGRAM is launched
+ with ARGS; the `:autoport' keyword substituted for that number;
+ and MOREARGS. Eglot then attempts to establish a TCP
+ connection to that port number on the localhost.
+
+* A cons (CLASS-NAME . INITARGS) where CLASS-NAME is a symbol
+ designating a subclass of `eglot-lsp-server', for representing
+ experimental LSP servers. INITARGS is a keyword-value plist
+ used to initialize the object of CLASS-NAME, or a plain list
+ interpreted as the previous descriptions of CONTACT. In the
+ latter case that plain list is used to produce a plist with a
+ suitable :PROCESS initarg to CLASS-NAME. The class
+ `eglot-lsp-server' descends from `jsonrpc-process-connection',
+ which you should see for the semantics of the mandatory
+ :PROCESS argument.
+
+* A function of a single argument producing any of the above
+ values for CONTACT. The argument's value is non-nil if the
+ connection was requested interactively (e.g. from the `eglot'
+ command), and nil if it wasn't (e.g. from `eglot-ensure'). If
+ the call is interactive, the function can ask the user for
+ hints on finding the required programs, etc. Otherwise, it
+ should not ask the user for any input, and return nil or signal
+ an error if it can't produce a valid CONTACT. The helper
+ function `eglot-alternatives' (which see) can be used to
+ produce a function that offers more than one server for a given
+ MAJOR-MODE.")
+
+(defface eglot-highlight-symbol-face
+ '((t (:inherit bold)))
+ "Face used to highlight the symbol at point.")
+
+(defface eglot-mode-line
+ '((t (:inherit font-lock-constant-face :weight bold)))
+ "Face for package-name in Eglot's mode line.")
+
+(defface eglot-diagnostic-tag-unnecessary-face
+ '((t (:inherit shadow)))
+ "Face used to render unused or unnecessary code.")
+
+(defface eglot-diagnostic-tag-deprecated-face
+ '((t . (:inherit shadow :strike-through t)))
+ "Face used to render deprecated or obsolete code.")
+
+(defcustom eglot-autoreconnect 3
+ "Control ability to reconnect automatically to the LSP server.
+If t, always reconnect automatically (not recommended). If nil,
+never reconnect automatically after unexpected server shutdowns,
+crashes or network failures. A positive integer number says to
+only autoreconnect if the previous successful connection attempt
+lasted more than that many seconds."
+ :type '(choice (const :tag "Reconnect automatically" t)
+ (const :tag "Never reconnect" nil)
+ (integer :tag "Number of seconds")))
+
+(defcustom eglot-connect-timeout 30
+ "Number of seconds before timing out LSP connection attempts.
+If nil, never time out."
+ :type '(choice (number :tag "Number of seconds")
+ (const :tag "Never time out" nil)))
+
+(defcustom eglot-sync-connect 3
+ "Control blocking of LSP connection attempts.
+If t, block for `eglot-connect-timeout' seconds. A positive
+integer number means block for that many seconds, and then wait
+for the connection in the background. nil has the same meaning
+as 0, i.e. don't block at all."
+ :type '(choice (const :tag "Block for `eglot-connect-timeout' seconds" t)
+ (const :tag "Never block" nil)
+ (integer :tag "Number of seconds to block")))
+
+(defcustom eglot-autoshutdown nil
+ "If non-nil, shut down server after killing last managed buffer."
+ :type 'boolean)
+
+(defcustom eglot-send-changes-idle-time 0.5
+ "Don't tell server of changes before Emacs's been idle for this many
seconds."
+ :type 'number)
+
+(defcustom eglot-events-buffer-size 2000000
+ "Control the size of the Eglot events buffer.
+If a number, don't let the buffer grow larger than that many
+characters. If 0, don't use an event's buffer at all. If nil,
+let the buffer grow forever.
+
+For changes on this variable to take effect on a connection
+already started, you need to restart the connection. That can be
+done by `eglot-reconnect'."
+ :type '(choice (const :tag "No limit" nil)
+ (integer :tag "Number of characters")))
+
+(defcustom eglot-confirm-server-initiated-edits 'confirm
+ "Non-nil if server-initiated edits should be confirmed with user."
+ :type '(choice (const :tag "Don't show confirmation prompt" nil)
+ (const :tag "Show confirmation prompt" confirm)))
+
+(defcustom eglot-extend-to-xref nil
+ "If non-nil, activate Eglot in cross-referenced non-project files."
+ :type 'boolean)
+
+(defcustom eglot-menu-string "eglot"
+ "String displayed in mode line when Eglot is active."
+ :type 'string)
+
+(defvar eglot-withhold-process-id nil
+ "If non-nil, Eglot will not send the Emacs process id to the language server.
+This can be useful when using docker to run a language server.")
+
+;; Customizable via `completion-category-overrides'.
+(when (assoc 'flex completion-styles-alist)
+ (add-to-list 'completion-category-defaults '(eglot (styles flex basic))))
+
+
+;;; Constants
+;;;
+(defconst eglot--symbol-kind-names
+ `((1 . "File") (2 . "Module")
+ (3 . "Namespace") (4 . "Package") (5 . "Class")
+ (6 . "Method") (7 . "Property") (8 . "Field")
+ (9 . "Constructor") (10 . "Enum") (11 . "Interface")
+ (12 . "Function") (13 . "Variable") (14 . "Constant")
+ (15 . "String") (16 . "Number") (17 . "Boolean")
+ (18 . "Array") (19 . "Object") (20 . "Key")
+ (21 . "Null") (22 . "EnumMember") (23 . "Struct")
+ (24 . "Event") (25 . "Operator") (26 . "TypeParameter")))
+
+(defconst eglot--kind-names
+ `((1 . "Text") (2 . "Method") (3 . "Function") (4 . "Constructor")
+ (5 . "Field") (6 . "Variable") (7 . "Class") (8 . "Interface")
+ (9 . "Module") (10 . "Property") (11 . "Unit") (12 . "Value")
+ (13 . "Enum") (14 . "Keyword") (15 . "Snippet") (16 . "Color")
+ (17 . "File") (18 . "Reference") (19 . "Folder") (20 . "EnumMember")
+ (21 . "Constant") (22 . "Struct") (23 . "Event") (24 . "Operator")
+ (25 . "TypeParameter")))
+
+(defconst eglot--tag-faces
+ `((1 . eglot-diagnostic-tag-unnecessary-face)
+ (2 . eglot-diagnostic-tag-deprecated-face)))
+
+(defvaralias 'eglot-{} 'eglot--{})
+(defconst eglot--{} (make-hash-table :size 1) "The empty JSON object.")
+
+(defun eglot--executable-find (command &optional remote)
+ "Like Emacs 27's `executable-find', ignore REMOTE on Emacs 26."
+ (if (>= emacs-major-version 27) (executable-find command remote)
+ (executable-find command)))
+
+
+;;; Message verification helpers
+;;;
+(eval-and-compile
+ (defvar eglot--lsp-interface-alist
+ `(
+ (CodeAction (:title) (:kind :diagnostics :edit :command :isPreferred))
+ (ConfigurationItem () (:scopeUri :section))
+ (Command ((:title . string) (:command . string)) (:arguments))
+ (CompletionItem (:label)
+ (:kind :detail :documentation :deprecated :preselect
+ :sortText :filterText :insertText
:insertTextFormat
+ :textEdit :additionalTextEdits :commitCharacters
+ :command :data :tags))
+ (Diagnostic (:range :message) (:severity :code :source
:relatedInformation :codeDescription :tags))
+ (DocumentHighlight (:range) (:kind))
+ (FileSystemWatcher (:globPattern) (:kind))
+ (Hover (:contents) (:range))
+ (InitializeResult (:capabilities) (:serverInfo))
+ (Location (:uri :range))
+ (LocationLink (:targetUri :targetRange :targetSelectionRange)
(:originSelectionRange))
+ (LogMessageParams (:type :message))
+ (MarkupContent (:kind :value))
+ (ParameterInformation (:label) (:documentation))
+ (Position (:line :character))
+ (Range (:start :end))
+ (Registration (:id :method) (:registerOptions))
+ (ResponseError (:code :message) (:data))
+ (ShowMessageParams (:type :message))
+ (ShowMessageRequestParams (:type :message) (:actions))
+ (SignatureHelp (:signatures) (:activeSignature :activeParameter))
+ (SignatureInformation (:label) (:documentation :parameters
:activeParameter))
+ (SymbolInformation (:name :kind :location)
+ (:deprecated :containerName))
+ (DocumentSymbol (:name :range :selectionRange :kind)
+ ;; `:containerName' isn't really allowed , but
+ ;; it simplifies the impl of `eglot-imenu'.
+ (:detail :deprecated :children :containerName))
+ (TextDocumentEdit (:textDocument :edits) ())
+ (TextEdit (:range :newText))
+ (VersionedTextDocumentIdentifier (:uri :version) ())
+ (WorkspaceEdit () (:changes :documentChanges))
+ (WorkspaceSymbol (:name :kind) (:containerName :location :data)))
+ "Alist (INTERFACE-NAME . INTERFACE) of known external LSP interfaces.
+
+INTERFACE-NAME is a symbol designated by the spec as
+\"interface\". INTERFACE is a list (REQUIRED OPTIONAL) where
+REQUIRED and OPTIONAL are lists of KEYWORD designating field
+names that must be, or may be, respectively, present in a message
+adhering to that interface. KEY can be a keyword or a cons (SYM
+TYPE), where type is used by `cl-typep' to check types at
+runtime.
+
+Here's what an element of this alist might look like:
+
+ (Command ((:title . string) (:command . string)) (:arguments))"))
+
+(eval-and-compile
+ (defvar eglot-strict-mode
+ '(;; Uncomment next lines for fun and debugging
+ ;; disallow-non-standard-keys
+ ;; enforce-required-keys
+ ;; enforce-optional-keys
+ )
+ "How strictly to check LSP interfaces at compile- and run-time.
+
+Value is a list of symbols (if the list is empty, no checks are
+performed).
+
+If the symbol `disallow-non-standard-keys' is present, an error
+is raised if any extraneous fields are sent by the server. At
+compile-time, a warning is raised if a destructuring spec
+includes such a field.
+
+If the symbol `enforce-required-keys' is present, an error is
+raised if any required fields are missing from the message sent
+from the server. At compile-time, a warning is raised if a
+destructuring spec doesn't use such a field.
+
+If the symbol `enforce-optional-keys' is present, nothing special
+happens at run-time. At compile-time, a warning is raised if a
+destructuring spec doesn't use all optional fields.
+
+If the symbol `disallow-unknown-methods' is present, Eglot warns
+on unknown notifications and errors on unknown requests."))
+
+(cl-defun eglot--check-object (interface-name
+ object
+ &optional
+ (enforce-required t)
+ (disallow-non-standard t)
+ (check-types t))
+ "Check that OBJECT conforms to INTERFACE. Error otherwise."
+ (cl-destructuring-bind
+ (&key types required-keys optional-keys &allow-other-keys)
+ (eglot--interface interface-name)
+ (when-let ((missing (and enforce-required
+ (cl-set-difference required-keys
+ (eglot--plist-keys object)))))
+ (eglot--error "A `%s' must have %s" interface-name missing))
+ (when-let ((excess (and disallow-non-standard
+ (cl-set-difference
+ (eglot--plist-keys object)
+ (append required-keys optional-keys)))))
+ (eglot--error "A `%s' mustn't have %s" interface-name excess))
+ (when check-types
+ (cl-loop
+ for (k v) on object by #'cddr
+ for type = (or (cdr (assoc k types)) t) ;; FIXME: enforce nil type?
+ unless (cl-typep v type)
+ do (eglot--error "A `%s' must have a %s as %s, but has %s"
+ interface-name )))
+ t))
+
+(eval-and-compile
+ (defun eglot--keywordize-vars (vars)
+ (mapcar (lambda (var) (intern (format ":%s" var))) vars))
+
+ (defun eglot--ensure-type (k) (if (consp k) k (cons k t)))
+
+ (defun eglot--interface (interface-name)
+ (let* ((interface (assoc interface-name eglot--lsp-interface-alist))
+ (required (mapcar #'eglot--ensure-type (car (cdr interface))))
+ (optional (mapcar #'eglot--ensure-type (cadr (cdr interface)))))
+ (list :types (append required optional)
+ :required-keys (mapcar #'car required)
+ :optional-keys (mapcar #'car optional))))
+
+ (defun eglot--check-dspec (interface-name dspec)
+ "Check destructuring spec DSPEC against INTERFACE-NAME."
+ (cl-destructuring-bind (&key required-keys optional-keys &allow-other-keys)
+ (eglot--interface interface-name)
+ (cond ((or required-keys optional-keys)
+ (let ((too-many
+ (and
+ (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (cl-set-difference
+ (eglot--keywordize-vars dspec)
+ (append required-keys optional-keys))))
+ (ignored-required
+ (and
+ (memq 'enforce-required-keys eglot-strict-mode)
+ (cl-set-difference
+ required-keys (eglot--keywordize-vars dspec))))
+ (missing-out
+ (and
+ (memq 'enforce-optional-keys eglot-strict-mode)
+ (cl-set-difference
+ optional-keys (eglot--keywordize-vars dspec)))))
+ (when too-many (byte-compile-warn
+ "Destructuring for %s has extraneous %s"
+ interface-name too-many))
+ (when ignored-required (byte-compile-warn
+ "Destructuring for %s ignores required
%s"
+ interface-name ignored-required))
+ (when missing-out (byte-compile-warn
+ "Destructuring for %s is missing out on %s"
+ interface-name missing-out))))
+ (t
+ (byte-compile-warn "Unknown LSP interface %s" interface-name))))))
+
+(cl-defmacro eglot--dbind (vars object &body body)
+ "Destructure OBJECT, binding VARS in BODY.
+VARS is ([(INTERFACE)] SYMS...)
+Honor `eglot-strict-mode'."
+ (declare (indent 2) (debug (sexp sexp &rest form)))
+ (let ((interface-name (if (consp (car vars))
+ (car (pop vars))))
+ (object-once (make-symbol "object-once"))
+ (fn-once (make-symbol "fn-once")))
+ (cond (interface-name
+ (eglot--check-dspec interface-name vars)
+ `(let ((,object-once ,object))
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys)
,object-once
+ (eglot--check-object ',interface-name ,object-once
+ (memq 'enforce-required-keys
eglot-strict-mode)
+ (memq 'disallow-non-standard-keys
eglot-strict-mode)
+ (memq 'check-types eglot-strict-mode))
+ ,@body)))
+ (t
+ `(let ((,object-once ,object)
+ (,fn-once (lambda (,@vars) ,@body)))
+ (if (memq 'disallow-non-standard-keys eglot-strict-mode)
+ (cl-destructuring-bind (&key ,@vars) ,object-once
+ (funcall ,fn-once ,@vars))
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys)
,object-once
+ (funcall ,fn-once ,@vars))))))))
+
+
+(cl-defmacro eglot--lambda (cl-lambda-list &body body)
+ "Function of args CL-LAMBDA-LIST for processing INTERFACE objects.
+Honor `eglot-strict-mode'."
+ (declare (indent 1) (debug (sexp &rest form)))
+ (let ((e (cl-gensym "jsonrpc-lambda-elem")))
+ `(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body))))
+
+(cl-defmacro eglot--dcase (obj &rest clauses)
+ "Like `pcase', but for the LSP object OBJ.
+CLAUSES is a list (DESTRUCTURE FORMS...) where DESTRUCTURE is
+treated as in `eglot--dbind'."
+ (declare (indent 1) (debug (sexp &rest (sexp &rest form))))
+ (let ((obj-once (make-symbol "obj-once")))
+ `(let ((,obj-once ,obj))
+ (cond
+ ,@(cl-loop
+ for (vars . body) in clauses
+ for vars-as-keywords = (eglot--keywordize-vars vars)
+ for interface-name = (if (consp (car vars))
+ (car (pop vars)))
+ for condition =
+ (cond (interface-name
+ (eglot--check-dspec interface-name vars)
+ ;; In this mode, in runtime, we assume
+ ;; `eglot-strict-mode' is partially on, otherwise we
+ ;; can't disambiguate between certain types.
+ `(ignore-errors
+ (eglot--check-object
+ ',interface-name ,obj-once
+ t
+ (memq 'disallow-non-standard-keys eglot-strict-mode)
+ t)))
+ (t
+ ;; In this interface-less mode we don't check
+ ;; `eglot-strict-mode' at all: just check that the object
+ ;; has all the keys the user wants to destructure.
+ `(null (cl-set-difference
+ ',vars-as-keywords
+ (eglot--plist-keys ,obj-once)))))
+ collect `(,condition
+ (cl-destructuring-bind (&key ,@vars &allow-other-keys)
+ ,obj-once
+ ,@body)))
+ (t
+ (eglot--error "%S didn't match any of %S"
+ ,obj-once
+ ',(mapcar #'car clauses)))))))
+
+
+;;; API (WORK-IN-PROGRESS!)
+;;;
+(cl-defmacro eglot--when-live-buffer (buf &rest body)
+ "Check BUF live, then do BODY in it." (declare (indent 1) (debug t))
+ (let ((b (cl-gensym)))
+ `(let ((,b ,buf)) (if (buffer-live-p ,b) (with-current-buffer ,b
,@body)))))
+
+(cl-defmacro eglot--when-buffer-window (buf &body body)
+ "Check BUF showing somewhere, then do BODY in it." (declare (indent 1)
(debug t))
+ (let ((b (cl-gensym)))
+ `(let ((,b ,buf))
+ ;;notice the exception when testing with `ert'
+ (when (or (get-buffer-window ,b) (ert-running-test))
+ (with-current-buffer ,b ,@body)))))
+
+(cl-defmacro eglot--widening (&rest body)
+ "Save excursion and restriction. Widen. Then run BODY." (declare (debug t))
+ `(save-excursion (save-restriction (widen) ,@body)))
+
+(cl-defgeneric eglot-handle-request (server method &rest params)
+ "Handle SERVER's METHOD request with PARAMS.")
+
+(cl-defgeneric eglot-handle-notification (server method &rest params)
+ "Handle SERVER's METHOD notification with PARAMS.")
+
+(cl-defgeneric eglot-execute-command (server command arguments)
+ "Ask SERVER to execute COMMAND with ARGUMENTS.")
+
+(cl-defgeneric eglot-initialization-options (server)
+ "JSON object to send under `initializationOptions'."
+ (:method (s)
+ (let ((probe (plist-get (eglot--saved-initargs s) :initializationOptions)))
+ (cond ((functionp probe) (funcall probe s))
+ (probe)
+ (t eglot--{})))))
+
+(cl-defgeneric eglot-register-capability (server method id &rest params)
+ "Ask SERVER to register capability METHOD marked with ID."
+ (:method
+ (_s method _id &rest _params)
+ (eglot--warn "Server tried to register unsupported capability `%s'"
+ method)))
+
+(cl-defgeneric eglot-unregister-capability (server method id &rest params)
+ "Ask SERVER to register capability METHOD marked with ID."
+ (:method
+ (_s method _id &rest _params)
+ (eglot--warn "Server tried to unregister unsupported capability `%s'"
+ method)))
+
+(cl-defgeneric eglot-client-capabilities (server)
+ "What the Eglot LSP client supports for SERVER."
+ (:method (s)
+ (list
+ :workspace (list
+ :applyEdit t
+ :executeCommand `(:dynamicRegistration :json-false)
+ :workspaceEdit `(:documentChanges t)
+ :didChangeWatchedFiles
+ `(:dynamicRegistration
+ ,(if (eglot--trampish-p s) :json-false t))
+ :symbol `(:dynamicRegistration :json-false)
+ :configuration t
+ :workspaceFolders t)
+ :textDocument
+ (list
+ :synchronization (list
+ :dynamicRegistration :json-false
+ :willSave t :willSaveWaitUntil t :didSave t)
+ :completion (list :dynamicRegistration :json-false
+ :completionItem
+ `(:snippetSupport
+ ,(if (eglot--snippet-expansion-fn)
+ t
+ :json-false)
+ :deprecatedSupport t
+ :tagSupport (:valueSet [1]))
+ :contextSupport t)
+ :hover (list :dynamicRegistration :json-false
+ :contentFormat
+ (if (fboundp 'gfm-view-mode)
+ ["markdown" "plaintext"]
+ ["plaintext"]))
+ :signatureHelp (list :dynamicRegistration :json-false
+ :signatureInformation
+ `(:parameterInformation
+ (:labelOffsetSupport t)
+ :activeParameterSupport t))
+ :references `(:dynamicRegistration :json-false)
+ :definition (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :declaration (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :implementation (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :typeDefinition (list :dynamicRegistration :json-false
+ :linkSupport t)
+ :documentSymbol (list
+ :dynamicRegistration :json-false
+ :hierarchicalDocumentSymbolSupport t
+ :symbolKind `(:valueSet
+ [,@(mapcar
+ #'car
eglot--symbol-kind-names)]))
+ :documentHighlight `(:dynamicRegistration :json-false)
+ :codeAction (list
+ :dynamicRegistration :json-false
+ :codeActionLiteralSupport
+ '(:codeActionKind
+ (:valueSet
+ ["quickfix"
+ "refactor" "refactor.extract"
+ "refactor.inline" "refactor.rewrite"
+ "source" "source.organizeImports"]))
+ :isPreferredSupport t)
+ :formatting `(:dynamicRegistration :json-false)
+ :rangeFormatting `(:dynamicRegistration :json-false)
+ :rename `(:dynamicRegistration :json-false)
+ :publishDiagnostics (list :relatedInformation :json-false
+ ;; TODO: We can support
:codeDescription after
+ ;; adding an appropriate UI to
+ ;; Flymake.
+ :codeDescriptionSupport :json-false
+ :tagSupport
+ `(:valueSet
+ [,@(mapcar
+ #'car eglot--tag-faces)])))
+ :experimental eglot--{})))
+
+(cl-defgeneric eglot-workspace-folders (server)
+ "Return workspaceFolders for SERVER."
+ (let ((project (eglot--project server)))
+ (vconcat
+ (mapcar (lambda (dir)
+ (list :uri (eglot--path-to-uri dir)
+ :name (abbreviate-file-name dir)))
+ `(,(project-root project) ,@(project-external-roots project))))))
+
+(defclass eglot-lsp-server (jsonrpc-process-connection)
+ ((project-nickname
+ :documentation "Short nickname for the associated project."
+ :accessor eglot--project-nickname
+ :reader eglot-project-nickname)
+ (major-modes
+ :documentation "Major modes server is responsible for in a given project."
+ :accessor eglot--major-modes)
+ (language-id
+ :documentation "Language ID string for the mode."
+ :accessor eglot--language-id)
+ (capabilities
+ :documentation "JSON object containing server capabilities."
+ :accessor eglot--capabilities)
+ (server-info
+ :documentation "JSON object containing server info."
+ :accessor eglot--server-info)
+ (shutdown-requested
+ :documentation "Flag set when server is shutting down."
+ :accessor eglot--shutdown-requested)
+ (project
+ :documentation "Project associated with server."
+ :accessor eglot--project)
+ (inhibit-autoreconnect
+ :initform t
+ :documentation "Generalized boolean inhibiting auto-reconnection if true."
+ :accessor eglot--inhibit-autoreconnect)
+ (file-watches
+ :documentation "Map ID to list of WATCHES for `didChangeWatchedFiles'."
+ :initform (make-hash-table :test #'equal) :accessor eglot--file-watches)
+ (managed-buffers
+ :documentation "List of buffers managed by server."
+ :accessor eglot--managed-buffers)
+ (saved-initargs
+ :documentation "Saved initargs for reconnection purposes."
+ :accessor eglot--saved-initargs)
+ (inferior-process
+ :documentation "Server subprocess started automatically."
+ :accessor eglot--inferior-process))
+ :documentation
+ "Represents a server. Wraps a process for LSP communication.")
+
+(cl-defmethod initialize-instance :before ((_server eglot-lsp-server)
&optional args)
+ (cl-remf args :initializationOptions))
+
+
+;;; Process management
+(defvar eglot--servers-by-project (make-hash-table :test #'equal)
+ "Keys are projects. Values are lists of processes.")
+
+(defun eglot-shutdown (server &optional _interactive timeout preserve-buffers)
+ "Politely ask SERVER to quit.
+Interactively, read SERVER from the minibuffer unless there is
+only one and it's managing the current buffer.
+
+Forcefully quit it if it doesn't respond within TIMEOUT seconds.
+TIMEOUT defaults to 1.5 seconds. Don't leave this function with
+the server still running.
+
+If PRESERVE-BUFFERS is non-nil (interactively, when called with a
+prefix argument), do not kill events and output buffers of
+SERVER."
+ (interactive (list (eglot--read-server "Shutdown which server"
+ (eglot-current-server))
+ t nil current-prefix-arg))
+ (eglot--message "Asking %s politely to terminate" (jsonrpc-name server))
+ (unwind-protect
+ (progn
+ (setf (eglot--shutdown-requested server) t)
+ (jsonrpc-request server :shutdown nil :timeout (or timeout 1.5))
+ (jsonrpc-notify server :exit nil))
+ ;; Now ask jsonrpc.el to shut down the server.
+ (jsonrpc-shutdown server (not preserve-buffers))
+ (unless preserve-buffers (kill-buffer (jsonrpc-events-buffer server)))))
+
+(defun eglot-shutdown-all (&optional preserve-buffers)
+ "Politely ask all language servers to quit, in order.
+PRESERVE-BUFFERS as in `eglot-shutdown', which see."
+ (interactive (list current-prefix-arg))
+ (cl-loop for ss being the hash-values of eglot--servers-by-project
+ do (with-demoted-errors "[eglot] shutdown all: %s"
+ (cl-loop for s in ss do (eglot-shutdown s nil nil
preserve-buffers)))))
+
+(defun eglot--on-shutdown (server)
+ "Called by jsonrpc.el when SERVER is already dead."
+ ;; Turn off `eglot--managed-mode' where appropriate.
+ (dolist (buffer (eglot--managed-buffers server))
+ (let (;; Avoid duplicate shutdowns (github#389)
+ (eglot-autoshutdown nil))
+ (eglot--when-live-buffer buffer (eglot--managed-mode-off))))
+ ;; Kill any expensive watches
+ (maphash (lambda (_id watches)
+ (mapcar #'file-notify-rm-watch watches))
+ (eglot--file-watches server))
+ ;; Kill any autostarted inferior processes
+ (when-let (proc (eglot--inferior-process server))
+ (delete-process proc))
+ ;; Sever the project/server relationship for `server'
+ (setf (gethash (eglot--project server) eglot--servers-by-project)
+ (delq server
+ (gethash (eglot--project server) eglot--servers-by-project)))
+ (cond ((eglot--shutdown-requested server)
+ t)
+ ((not (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Reconnecting after unexpected server exit.")
+ (eglot-reconnect server))
+ ((timerp (eglot--inhibit-autoreconnect server))
+ (eglot--warn "Not auto-reconnecting, last one didn't last long."))))
+
+(defun eglot--all-major-modes ()
+ "Return all known major modes."
+ (let ((retval))
+ (mapatoms (lambda (sym)
+ (when (plist-member (symbol-plist sym) 'derived-mode-parent)
+ (push sym retval))))
+ retval))
+
+(defvar eglot--command-history nil
+ "History of CONTACT arguments to `eglot'.")
+
+(defun eglot--lookup-mode (mode)
+ "Lookup `eglot-server-programs' for MODE.
+Return (MANAGED-MODES LANGUAGE-ID CONTACT-PROXY).
+
+MANAGED-MODES is a list with MODE as its first elements.
+Subsequent elements are other major modes also potentially
+managed by the server that is to manage MODE.
+
+If not specified in `eglot-server-programs' (which see),
+LANGUAGE-ID is determined from MODE's name.
+
+CONTACT-PROXY is the value of the corresponding
+`eglot-server-programs' entry."
+ (cl-loop
+ for (modes . contact) in eglot-server-programs
+ for mode-symbols = (cons mode
+ (delete mode
+ (mapcar #'car
+ (mapcar #'eglot--ensure-list
+ (eglot--ensure-list
modes)))))
+ thereis (cl-some
+ (lambda (spec)
+ (cl-destructuring-bind (probe &key language-id &allow-other-keys)
+ (eglot--ensure-list spec)
+ (and (provided-mode-derived-p mode probe)
+ (list
+ mode-symbols
+ (or language-id
+ (or (get mode 'eglot-language-id)
+ (get spec 'eglot-language-id)
+ (string-remove-suffix "-mode" (symbol-name
mode))))
+ contact))))
+ (if (or (symbolp modes) (keywordp (cadr modes)))
+ (list modes) modes))))
+
+(defun eglot--guess-contact (&optional interactive)
+ "Helper for `eglot'.
+Return (MANAGED-MODE PROJECT CLASS CONTACT LANG-ID). If INTERACTIVE is
+non-nil, maybe prompt user, else error as soon as something can't
+be guessed."
+ (let* ((guessed-mode (if buffer-file-name major-mode))
+ (main-mode
+ (cond
+ ((and interactive
+ (or (>= (prefix-numeric-value current-prefix-arg) 16)
+ (not guessed-mode)))
+ (intern
+ (completing-read
+ "[eglot] Start a server to manage buffers of what major mode? "
+ (mapcar #'symbol-name (eglot--all-major-modes)) nil t
+ (symbol-name guessed-mode) nil (symbol-name guessed-mode) nil)))
+ ((not guessed-mode)
+ (eglot--error "Can't guess mode to manage for `%s'"
(current-buffer)))
+ (t guessed-mode)))
+ (triplet (eglot--lookup-mode main-mode))
+ (managed-modes (car triplet))
+ (language-id (or (cadr triplet)
+ (string-remove-suffix "-mode" (symbol-name
guessed-mode))))
+ (guess (caddr triplet))
+ (guess (if (functionp guess)
+ (funcall guess interactive)
+ guess))
+ (class (or (and (consp guess) (symbolp (car guess))
+ (prog1 (unless current-prefix-arg (car guess))
+ (setq guess (cdr guess))))
+ 'eglot-lsp-server))
+ (program (and (listp guess)
+ (stringp (car guess))
+ ;; A second element might be the port of a (host, port)
+ ;; pair, but in that case it is not a string.
+ (or (null (cdr guess)) (stringp (cadr guess)))
+ (car guess)))
+ (base-prompt
+ (and interactive
+ "Enter program to execute (or <host>:<port>): "))
+ (full-program-invocation
+ (and program
+ (cl-every #'stringp guess)
+ (combine-and-quote-strings guess)))
+ (prompt
+ (and base-prompt
+ (cond (current-prefix-arg base-prompt)
+ ((null guess)
+ (format "[eglot] Sorry, couldn't guess for `%s'!\n%s"
+ main-mode base-prompt))
+ ((and program
+ (not (file-name-absolute-p program))
+ (not (eglot--executable-find program t)))
+ (if full-program-invocation
+ (concat (format "[eglot] I guess you want to run
`%s'"
+ full-program-invocation)
+ (format ", but I can't find `%s' in PATH!"
+ program)
+ "\n" base-prompt)
+ (eglot--error
+ (concat "`%s' not found in PATH, but can't form"
+ " an interactive prompt for to fix %s!")
+ program guess))))))
+ (contact
+ (or (and prompt
+ (split-string-and-unquote
+ (read-shell-command
+ prompt
+ full-program-invocation
+ 'eglot-command-history)))
+ guess)))
+ (list managed-modes (eglot--current-project) class contact language-id)))
+
+(defvar eglot-lsp-context)
+(put 'eglot-lsp-context 'variable-documentation
+ "Dynamically non-nil when searching for projects in LSP context.")
+
+(defvar eglot--servers-by-xrefed-file
+ (make-hash-table :test 'equal :weakness 'value))
+
+(defun eglot--current-project ()
+ "Return a project object for Eglot's LSP purposes.
+This relies on `project-current' and thus on
+`project-find-functions'. Functions in the latter
+variable (which see) can query the value `eglot-lsp-context' to
+decide whether a given directory is a project containing a
+suitable root directory for a given LSP server's purposes."
+ (let ((eglot-lsp-context t))
+ (or (project-current) `(transient . ,default-directory))))
+
+;;;###autoload
+(defun eglot (managed-major-mode project class contact language-id
+ &optional interactive)
+ "Start LSP server in support of PROJECT's buffers under MANAGED-MAJOR-MODE.
+
+This starts a Language Server Protocol (LSP) server suitable for the
+buffers of PROJECT whose `major-mode' is MANAGED-MAJOR-MODE.
+CLASS is the class of the LSP server to start and CONTACT specifies
+how to connect to the server.
+
+Interactively, the command attempts to guess MANAGED-MAJOR-MODE
+from the current buffer's `major-mode', CLASS and CONTACT from
+`eglot-server-programs' looked up by the major mode, and PROJECT from
+`project-find-functions'. The search for active projects in this
+context binds `eglot-lsp-context' (which see).
+
+If it can't guess, it prompts the user for the mode and the server.
+With a single \\[universal-argument] prefix arg, it always prompts for COMMAND.
+With two \\[universal-argument], it also always prompts for MANAGED-MAJOR-MODE.
+
+The LSP server of CLASS is started (or contacted) via CONTACT.
+If this operation is successful, current *and future* file
+buffers of MANAGED-MAJOR-MODE inside PROJECT become \"managed\"
+by the LSP server, meaning the information about their contents is
+exchanged periodically with the server to provide enhanced
+code-analysis via `xref-find-definitions', `flymake-mode',
+`eldoc-mode', and `completion-at-point', among others.
+
+PROJECT is a project object as returned by `project-current'.
+
+CLASS is a subclass of `eglot-lsp-server'.
+
+CONTACT specifies how to contact the server. It is a
+keyword-value plist used to initialize CLASS or a plain list as
+described in `eglot-server-programs', which see.
+
+LANGUAGE-ID is the language ID string to send to the server for
+MANAGED-MAJOR-MODE, which matters to a minority of servers.
+
+INTERACTIVE is t if called interactively."
+ (interactive (append (eglot--guess-contact t) '(t)))
+ (setq managed-major-mode (eglot--ensure-list managed-major-mode))
+ (let* ((current-server (eglot-current-server))
+ (live-p (and current-server (jsonrpc-running-p current-server))))
+ (if (and live-p
+ interactive
+ (y-or-n-p "[eglot] Live process found, reconnect instead? "))
+ (eglot-reconnect current-server interactive)
+ (when live-p (ignore-errors (eglot-shutdown current-server)))
+ (eglot--connect managed-major-mode project class contact language-id))))
+
+(defun eglot-reconnect (server &optional interactive)
+ "Reconnect to SERVER.
+INTERACTIVE is t if called interactively."
+ (interactive (list (eglot--current-server-or-lose) t))
+ (when (jsonrpc-running-p server)
+ (ignore-errors (eglot-shutdown server interactive nil 'preserve-buffers)))
+ (eglot--connect (eglot--major-modes server)
+ (eglot--project server)
+ (eieio-object-class-name server)
+ (eglot--saved-initargs server)
+ (eglot--language-id server))
+ (eglot--message "Reconnected!"))
+
+(defvar eglot--managed-mode) ; forward decl
+
+;;;###autoload
+(defun eglot-ensure ()
+ "Start Eglot session for current buffer if there isn't one."
+ (let ((buffer (current-buffer)))
+ (cl-labels
+ ((maybe-connect
+ ()
+ (remove-hook 'post-command-hook #'maybe-connect nil)
+ (eglot--when-live-buffer buffer
+ (unless eglot--managed-mode
+ (apply #'eglot--connect (eglot--guess-contact))))))
+ (when buffer-file-name
+ (add-hook 'post-command-hook #'maybe-connect 'append nil)))))
+
+(defun eglot-events-buffer (server)
+ "Display events buffer for SERVER.
+Use current server's or first available Eglot events buffer."
+ (interactive (list (eglot-current-server)))
+ (let ((buffer (if server (jsonrpc-events-buffer server)
+ (cl-find "\\*EGLOT.*events\\*"
+ (buffer-list)
+ :key #'buffer-name :test #'string-match))))
+ (if buffer (display-buffer buffer)
+ (eglot--error "Can't find an Eglot events buffer!"))))
+
+(defun eglot-stderr-buffer (server)
+ "Display stderr buffer for SERVER."
+ (interactive (list (eglot--current-server-or-lose)))
+ (display-buffer (jsonrpc-stderr-buffer server)))
+
+(defun eglot-forget-pending-continuations (server)
+ "Forget pending requests for SERVER."
+ (interactive (list (eglot--current-server-or-lose)))
+ (jsonrpc-forget-pending-continuations server))
+
+(defvar eglot-connect-hook
+ '(eglot-signal-didChangeConfiguration)
+ "Hook run after connecting in `eglot--connect'.")
+
+(defvar eglot-server-initialized-hook
+ '()
+ "Hook run after a `eglot-lsp-server' instance is created.
+
+That is before a connection was established. Use
+`eglot-connect-hook' to hook into when a connection was
+successfully established and the server on the other side has
+received the initializing configuration.
+
+Each function is passed the server as an argument")
+
+(defun eglot--cmd (contact)
+ "Helper for `eglot--connect'."
+ (if (file-remote-p default-directory)
+ ;; TODO: this seems like a bug, although it’s everywhere. For
+ ;; some reason, for remote connections only, over a pipe, we
+ ;; need to turn off line buffering on the tty.
+ ;;
+ ;; Not only does this seem like there should be a better way,
+ ;; but it almost certainly doesn’t work on non-unix systems.
+ (list "sh" "-c"
+ (string-join (cons "stty raw > /dev/null;"
+ (mapcar #'shell-quote-argument contact))
+ " "))
+ contact))
+
+(defvar-local eglot--cached-server nil
+ "A cached reference to the current Eglot server.")
+
+(defun eglot--connect (managed-modes project class contact language-id)
+ "Connect to MANAGED-MODES, LANGUAGE-ID, PROJECT, CLASS and CONTACT.
+This docstring appeases checkdoc, that's all."
+ (let* ((default-directory (project-root project))
+ (nickname (file-name-base (directory-file-name default-directory)))
+ (readable-name (format "EGLOT (%s/%s)" nickname managed-modes))
+ autostart-inferior-process
+ server-info
+ (contact (if (functionp contact) (funcall contact) contact))
+ (initargs
+ (cond ((keywordp (car contact)) contact)
+ ((integerp (cadr contact))
+ (setq server-info (list (format "%s:%s" (car contact)
+ (cadr contact))))
+ `(:process ,(lambda ()
+ (apply #'open-network-stream
+ readable-name nil
+ (car contact) (cadr contact)
+ (cddr contact)))))
+ ((and (stringp (car contact)) (memq :autoport contact))
+ (setq server-info (list "<inferior process>"))
+ `(:process ,(lambda ()
+ (pcase-let ((`(,connection . ,inferior)
+ (eglot--inferior-bootstrap
+ readable-name
+ contact
+ '(:noquery t))))
+ (setq autostart-inferior-process inferior)
+ connection))))
+ ((stringp (car contact))
+ (let* ((probe (cl-position-if #'keywordp contact))
+ (more-initargs (and probe (cl-subseq contact probe)))
+ (contact (cl-subseq contact 0 probe)))
+ `(:process
+ ,(lambda ()
+ (let ((default-directory default-directory))
+ (make-process
+ :name readable-name
+ :command (setq server-info (eglot--cmd contact))
+ :connection-type 'pipe
+ :coding 'utf-8-emacs-unix
+ :noquery t
+ :stderr (get-buffer-create
+ (format "*%s stderr*" readable-name))
+ :file-handler t)))
+ ,@more-initargs)))))
+ (spread (lambda (fn) (lambda (server method params)
+ (let ((eglot--cached-server server))
+ (apply fn server method (append params
nil))))))
+ (server
+ (apply
+ #'make-instance class
+ :name readable-name
+ :events-buffer-scrollback-size eglot-events-buffer-size
+ :notification-dispatcher (funcall spread
#'eglot-handle-notification)
+ :request-dispatcher (funcall spread #'eglot-handle-request)
+ :on-shutdown #'eglot--on-shutdown
+ initargs))
+ (canceled nil)
+ (tag (make-symbol "connected-catch-tag")))
+ (when server-info
+ (jsonrpc--debug server "Running language server: %s"
+ (string-join server-info " ")))
+ (setf (eglot--saved-initargs server) initargs)
+ (setf (eglot--project server) project)
+ (setf (eglot--project-nickname server) nickname)
+ (setf (eglot--major-modes server) (eglot--ensure-list managed-modes))
+ (setf (eglot--language-id server) language-id)
+ (setf (eglot--inferior-process server) autostart-inferior-process)
+ (run-hook-with-args 'eglot-server-initialized-hook server)
+ ;; Now start the handshake. To honor `eglot-sync-connect'
+ ;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request'
+ ;; and mimic most of `jsonrpc-request'.
+ (unwind-protect
+ (condition-case _quit
+ (let ((retval
+ (catch tag
+ (jsonrpc-async-request
+ server
+ :initialize
+ (list :processId
+ (unless (or eglot-withhold-process-id
+ (file-remote-p default-directory)
+ (eq (jsonrpc-process-type server)
+ 'network))
+ (emacs-pid))
+ ;; Maybe turn trampy `/ssh:foo@bar:/path/to/baz.py'
+ ;; into `/path/to/baz.py', so LSP groks it.
+ :rootPath (file-local-name
+ (expand-file-name default-directory))
+ :rootUri (eglot--path-to-uri default-directory)
+ :initializationOptions
(eglot-initialization-options
+ server)
+ :capabilities (eglot-client-capabilities server)
+ :workspaceFolders (eglot-workspace-folders server))
+ :success-fn
+ (eglot--lambda ((InitializeResult) capabilities
serverInfo)
+ (unless canceled
+ (push server
+ (gethash project eglot--servers-by-project))
+ (setf (eglot--capabilities server) capabilities)
+ (setf (eglot--server-info server) serverInfo)
+ (jsonrpc-notify server :initialized eglot--{})
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ ;; No need to pass SERVER as an argument: it has
+ ;; been registered in
`eglot--servers-by-project',
+ ;; so that it can be found (and cached) from
+ ;; `eglot--maybe-activate-editing-mode' in any
+ ;; managed buffer.
+ (eglot--maybe-activate-editing-mode)))
+ (setf (eglot--inhibit-autoreconnect server)
+ (cond
+ ((booleanp eglot-autoreconnect)
+ (not eglot-autoreconnect))
+ ((cl-plusp eglot-autoreconnect)
+ (run-with-timer
+ eglot-autoreconnect nil
+ (lambda ()
+ (setf (eglot--inhibit-autoreconnect
server)
+ (null eglot-autoreconnect)))))))
+ (let ((default-directory (project-root project))
+ (major-mode (car managed-modes)))
+ (hack-dir-local-variables-non-file-buffer)
+ (run-hook-with-args 'eglot-connect-hook server))
+ (eglot--message
+ "Connected! Server `%s' now managing `%s' buffers \
+in project `%s'."
+ (or (plist-get serverInfo :name)
+ (jsonrpc-name server))
+ managed-modes
+ (eglot-project-nickname server))
+ (when tag (throw tag t))))
+ :timeout eglot-connect-timeout
+ :error-fn (eglot--lambda ((ResponseError) code message)
+ (unless canceled
+ (jsonrpc-shutdown server)
+ (let ((msg (format "%s: %s" code message)))
+ (if tag (throw tag `(error . ,msg))
+ (eglot--error msg)))))
+ :timeout-fn (lambda ()
+ (unless canceled
+ (jsonrpc-shutdown server)
+ (let ((msg (format "Timed out after %s
seconds"
+
eglot-connect-timeout)))
+ (if tag (throw tag `(error . ,msg))
+ (eglot--error msg))))))
+ (cond ((numberp eglot-sync-connect)
+ (accept-process-output nil eglot-sync-connect))
+ (eglot-sync-connect
+ (while t (accept-process-output
+ nil eglot-connect-timeout)))))))
+ (pcase retval
+ (`(error . ,msg) (eglot--error msg))
+ (`nil (eglot--message "Waiting in background for server `%s'"
+ (jsonrpc-name server))
+ nil)
+ (_ server)))
+ (quit (jsonrpc-shutdown server) (setq canceled 'quit)))
+ (setq tag nil))))
+
+(defun eglot--inferior-bootstrap (name contact &optional connect-args)
+ "Use CONTACT to start a server, then connect to it.
+Return a cons of two process objects (CONNECTION . INFERIOR).
+Name both based on NAME.
+CONNECT-ARGS are passed as additional arguments to
+`open-network-stream'."
+ (let* ((port-probe (make-network-process :name "eglot-port-probe-dummy"
+ :server t
+ :host "localhost"
+ :service 0))
+ (port-number (unwind-protect
+ (process-contact port-probe :service)
+ (delete-process port-probe)))
+ inferior connection)
+ (unwind-protect
+ (progn
+ (setq inferior
+ (make-process
+ :name (format "autostart-inferior-%s" name)
+ :stderr (format "*%s stderr*" name)
+ :noquery t
+ :command (cl-subst
+ (format "%s" port-number) :autoport contact)))
+ (setq connection
+ (cl-loop
+ repeat 10 for i from 1
+ do (accept-process-output nil 0.5)
+ while (process-live-p inferior)
+ do (eglot--message
+ "Trying to connect to localhost and port %s (attempt %s)"
+ port-number i)
+ thereis (ignore-errors
+ (apply #'open-network-stream
+ (format "autoconnect-%s" name)
+ nil
+ "localhost" port-number connect-args))))
+ (cons connection inferior))
+ (cond ((and (process-live-p connection)
+ (process-live-p inferior))
+ (eglot--message "Done, connected to %s!" port-number))
+ (t
+ (when inferior (delete-process inferior))
+ (when connection (delete-process connection))
+ (eglot--error "Could not start and connect to server%s"
+ (if inferior
+ (format " started with %s"
+ (process-command inferior))
+ "!")))))))
+
+
+;;; Helpers (move these to API?)
+;;;
+(defun eglot--error (format &rest args)
+ "Error out with FORMAT with ARGS."
+ (error "[eglot] %s" (apply #'format format args)))
+
+(defun eglot--message (format &rest args)
+ "Message out with FORMAT with ARGS."
+ (message "[eglot] %s" (apply #'format format args)))
+
+(defun eglot--warn (format &rest args)
+ "Warning message with FORMAT and ARGS."
+ (apply #'eglot--message (concat "(warning) " format) args)
+ (let ((warning-minimum-level :error))
+ (display-warning 'eglot (apply #'format format args) :warning)))
+
+(defun eglot-current-column () (- (point) (line-beginning-position)))
+
+(defvar eglot-current-column-function #'eglot-lsp-abiding-column
+ "Function to calculate the current column.
+
+This is the inverse operation of
+`eglot-move-to-column-function' (which see). It is a function of
+no arguments returning a column number. For buffers managed by
+fully LSP-compliant servers, this should be set to
+`eglot-lsp-abiding-column' (the default), and
+`eglot-current-column' for all others.")
+
+(defun eglot-lsp-abiding-column (&optional lbp)
+ "Calculate current COLUMN as defined by the LSP spec.
+LBP defaults to `line-beginning-position'."
+ (/ (- (length (encode-coding-region (or lbp (line-beginning-position))
+ ;; Fix github#860
+ (min (point) (point-max)) 'utf-16 t))
+ 2)
+ 2))
+
+(defun eglot--pos-to-lsp-position (&optional pos)
+ "Convert point POS to LSP position."
+ (eglot--widening
+ ;; LSP line is zero-origin; emacs is one-origin.
+ (list :line (1- (line-number-at-pos pos t))
+ :character (progn (when pos (goto-char pos))
+ (funcall eglot-current-column-function)))))
+
+(defvar eglot-move-to-column-function #'eglot-move-to-lsp-abiding-column
+ "Function to move to a column reported by the LSP server.
+
+According to the standard, LSP column/character offsets are based
+on a count of UTF-16 code units, not actual visual columns. So
+when LSP says position 3 of a line containing just \"aXbc\",
+where X is a multi-byte character, it actually means `b', not
+`c'. However, many servers don't follow the spec this closely.
+
+For buffers managed by fully LSP-compliant servers, this should
+be set to `eglot-move-to-lsp-abiding-column' (the default), and
+`eglot-move-to-column' for all others.")
+
+(defun eglot-move-to-column (column)
+ "Move to COLUMN without closely following the LSP spec."
+ ;; We cannot use `move-to-column' here, because it moves to *visual*
+ ;; columns, which can be different from LSP columns in case of
+ ;; `whitespace-mode', `prettify-symbols-mode', etc. (github#296,
+ ;; github#297)
+ (goto-char (min (+ (line-beginning-position) column)
+ (line-end-position))))
+
+(defun eglot-move-to-lsp-abiding-column (column)
+ "Move to COLUMN abiding by the LSP spec."
+ (save-restriction
+ (cl-loop
+ with lbp = (line-beginning-position)
+ initially
+ (narrow-to-region lbp (line-end-position))
+ (move-to-column column)
+ for diff = (- column
+ (eglot-lsp-abiding-column lbp))
+ until (zerop diff)
+ do (condition-case eob-err
+ (forward-char (/ (if (> diff 0) (1+ diff) (1- diff)) 2))
+ (end-of-buffer (cl-return eob-err))))))
+
+(defun eglot--lsp-position-to-point (pos-plist &optional marker)
+ "Convert LSP position POS-PLIST to Emacs point.
+If optional MARKER, return a marker instead"
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (min most-positive-fixnum
+ (plist-get pos-plist :line)))
+ (unless (eobp) ;; if line was excessive leave point at eob
+ (let ((tab-width 1)
+ (col (plist-get pos-plist :character)))
+ (unless (wholenump col)
+ (eglot--warn
+ "Caution: LSP server sent invalid character position %s. Using 0
instead."
+ col)
+ (setq col 0))
+ (funcall eglot-move-to-column-function col)))
+ (if marker (copy-marker (point-marker)) (point)))))
+
+(defconst eglot--uri-path-allowed-chars
+ (let ((vec (copy-sequence url-path-allowed-chars)))
+ (aset vec ?: nil) ;; see github#639
+ vec)
+ "Like `url-path-allows-chars' but more restrictive.")
+
+(defun eglot--path-to-uri (path)
+ "URIfy PATH."
+ (let ((truepath (file-truename path)))
+ (if (url-type (url-generic-parse-url truepath))
+ ;; Path is already a URI, so forward it to the LSP server
+ ;; untouched. The server should be able to handle it, since
+ ;; it provided this URI to clients in the first place.
+ truepath
+ (concat "file://"
+ ;; Add a leading "/" for local MS Windows-style paths.
+ (if (and (eq system-type 'windows-nt)
+ (not (file-remote-p truepath)))
+ "/")
+ (url-hexify-string
+ ;; Again watch out for trampy paths.
+ (directory-file-name (file-local-name truepath))
+ eglot--uri-path-allowed-chars)))))
+
+(defun eglot--uri-to-path (uri)
+ "Convert URI to file path, helped by `eglot--current-server'."
+ (when (keywordp uri) (setq uri (substring (symbol-name uri) 1)))
+ (let* ((server (eglot-current-server))
+ (remote-prefix (and server (eglot--trampish-p server)))
+ (url (url-generic-parse-url uri)))
+ ;; Only parse file:// URIs, leave other URI untouched as
+ ;; `file-name-handler-alist' should know how to handle them
+ ;; (bug#58790).
+ (if (string= "file" (url-type url))
+ (let* ((retval (url-unhex-string (url-filename url)))
+ ;; Remove the leading "/" for local MS Windows-style paths.
+ (normalized (if (and (not remote-prefix)
+ (eq system-type 'windows-nt)
+ (cl-plusp (length retval)))
+ (substring retval 1)
+ retval)))
+ (concat remote-prefix normalized))
+
+ uri)))
+
+(defun eglot--snippet-expansion-fn ()
+ "Compute a function to expand snippets.
+Doubles as an indicator of snippet support."
+ (and (boundp 'yas-minor-mode)
+ (symbol-value 'yas-minor-mode)
+ 'yas-expand-snippet))
+
+(defun eglot--format-markup (markup)
+ "Format MARKUP according to LSP's spec."
+ (pcase-let ((`(,string ,mode)
+ (if (stringp markup) (list markup 'gfm-view-mode)
+ (list (plist-get markup :value)
+ (pcase (plist-get markup :kind)
+ ("markdown" 'gfm-view-mode)
+ ("plaintext" 'text-mode)
+ (_ major-mode))))))
+ (with-temp-buffer
+ (setq-local markdown-fontify-code-blocks-natively t)
+ (insert string)
+ (let ((inhibit-message t)
+ (message-log-max nil))
+ (ignore-errors (delay-mode-hooks (funcall mode))))
+ (font-lock-ensure)
+ (string-trim (buffer-string)))))
+
+(define-obsolete-variable-alias 'eglot-ignored-server-capabilites
+ 'eglot-ignored-server-capabilities "1.8")
+
+(defcustom eglot-ignored-server-capabilities (list)
+ "LSP server capabilities that Eglot could use, but won't.
+You could add, for instance, the symbol
+`:documentHighlightProvider' to prevent automatic highlighting
+under cursor."
+ :type '(set
+ :tag "Tick the ones you're not interested in"
+ (const :tag "Documentation on hover" :hoverProvider)
+ (const :tag "Code completion" :completionProvider)
+ (const :tag "Function signature help" :signatureHelpProvider)
+ (const :tag "Go to definition" :definitionProvider)
+ (const :tag "Go to type definition" :typeDefinitionProvider)
+ (const :tag "Go to implementation" :implementationProvider)
+ (const :tag "Go to declaration" :implementationProvider)
+ (const :tag "Find references" :referencesProvider)
+ (const :tag "Highlight symbols automatically"
:documentHighlightProvider)
+ (const :tag "List symbols in buffer" :documentSymbolProvider)
+ (const :tag "List symbols in workspace" :workspaceSymbolProvider)
+ (const :tag "Execute code actions" :codeActionProvider)
+ (const :tag "Code lens" :codeLensProvider)
+ (const :tag "Format buffer" :documentFormattingProvider)
+ (const :tag "Format portion of buffer"
:documentRangeFormattingProvider)
+ (const :tag "On-type formatting" :documentOnTypeFormattingProvider)
+ (const :tag "Rename symbol" :renameProvider)
+ (const :tag "Highlight links in document" :documentLinkProvider)
+ (const :tag "Decorate color references" :colorProvider)
+ (const :tag "Fold regions of buffer" :foldingRangeProvider)
+ (const :tag "Execute custom commands" :executeCommandProvider)))
+
+(defun eglot--server-capable (&rest feats)
+ "Determine if current server is capable of FEATS."
+ (unless (cl-some (lambda (feat)
+ (memq feat eglot-ignored-server-capabilities))
+ feats)
+ (cl-loop for caps = (eglot--capabilities (eglot--current-server-or-lose))
+ then (cadr probe)
+ for (feat . more) on feats
+ for probe = (plist-member caps feat)
+ if (not probe) do (cl-return nil)
+ if (eq (cadr probe) :json-false) do (cl-return nil)
+ if (not (listp (cadr probe))) do (cl-return (if more nil (cadr
probe)))
+ finally (cl-return (or (cadr probe) t)))))
+
+(defun eglot--range-region (range &optional markers)
+ "Return region (BEG . END) that represents LSP RANGE.
+If optional MARKERS, make markers."
+ (let* ((st (plist-get range :start))
+ (beg (eglot--lsp-position-to-point st markers))
+ (end (eglot--lsp-position-to-point (plist-get range :end) markers)))
+ (cons beg end)))
+
+(defun eglot--read-server (prompt &optional dont-if-just-the-one)
+ "Read a running Eglot server from minibuffer using PROMPT.
+If DONT-IF-JUST-THE-ONE and there's only one server, don't prompt
+and just return it. PROMPT shouldn't end with a question mark."
+ (let ((servers (cl-loop for servers
+ being hash-values of eglot--servers-by-project
+ append servers))
+ (name (lambda (srv)
+ (format "%s %s" (eglot-project-nickname srv)
+ (eglot--major-modes srv)))))
+ (cond ((null servers)
+ (eglot--error "No servers!"))
+ ((or (cdr servers) (not dont-if-just-the-one))
+ (let* ((default (when-let ((current (eglot-current-server)))
+ (funcall name current)))
+ (read (completing-read
+ (if default
+ (format "%s (default %s)? " prompt default)
+ (concat prompt "? "))
+ (mapcar name servers)
+ nil t
+ nil nil
+ default)))
+ (cl-find read servers :key name :test #'equal)))
+ (t (car servers)))))
+
+(defun eglot--trampish-p (server)
+ "Tell if SERVER's project root is `file-remote-p'."
+ (file-remote-p (project-root (eglot--project server))))
+
+(defun eglot--plist-keys (plist) "Get keys of a plist."
+ (cl-loop for (k _v) on plist by #'cddr collect k))
+
+(defun eglot--ensure-list (x) (if (listp x) x (list x)))
+(when (fboundp 'ensure-list) ; Emacs 28 or later
+ (define-obsolete-function-alias 'eglot--ensure-list #'ensure-list "29.1"))
+
+
+;;; Minor modes
+;;;
+(defvar eglot-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [remap display-local-help] #'eldoc-doc-buffer)
+ map))
+
+(defvar-local eglot--current-flymake-report-fn nil
+ "Current flymake report function for this buffer.")
+
+(defvar-local eglot--saved-bindings nil
+ "Bindings saved by `eglot--setq-saving'.")
+
+(defvar eglot-stay-out-of '()
+ "List of Emacs things that Eglot should try to stay of.
+Each element is a string, a symbol, or a regexp which is matched
+against a variable's name. Examples include the string
+\"company\" or the symbol `xref'.
+
+Before Eglot starts \"managing\" a particular buffer, it
+opinionatedly sets some peripheral Emacs facilities, such as
+Flymake, Xref and Company. These overriding settings help ensure
+consistent Eglot behavior and only stay in place until
+\"managing\" stops (usually via `eglot-shutdown'), whereupon the
+previous settings are restored.
+
+However, if you wish for Eglot to stay out of a particular Emacs
+facility that you'd like to keep control of add an element to
+this list and Eglot will refrain from setting it.
+
+For example, to keep your Company customization, add the symbol
+`company' to this variable.")
+
+(defun eglot--stay-out-of-p (symbol)
+ "Tell if Eglot should stay out of SYMBOL."
+ (cl-find (symbol-name symbol) eglot-stay-out-of
+ :test (lambda (s thing)
+ (let ((re (if (symbolp thing) (symbol-name thing) thing)))
+ (string-match re s)))))
+
+(defmacro eglot--setq-saving (symbol binding)
+ `(unless (or (not (boundp ',symbol)) (eglot--stay-out-of-p ',symbol))
+ (push (cons ',symbol (symbol-value ',symbol)) eglot--saved-bindings)
+ (setq-local ,symbol ,binding)))
+
+(defun eglot-managed-p ()
+ "Tell if current buffer is managed by Eglot."
+ eglot--managed-mode)
+
+(defvar eglot-managed-mode-hook nil
+ "A hook run by Eglot after it started/stopped managing a buffer.
+Use `eglot-managed-p' to determine if current buffer is managed.")
+
+(define-minor-mode eglot--managed-mode
+ "Mode for source buffers managed by some Eglot project."
+ :init-value nil :lighter nil :keymap eglot-mode-map
+ (cond
+ (eglot--managed-mode
+ (add-hook 'after-change-functions 'eglot--after-change nil t)
+ (add-hook 'before-change-functions 'eglot--before-change nil t)
+ (add-hook 'kill-buffer-hook #'eglot--managed-mode-off nil t)
+ ;; Prepend "didClose" to the hook after the "nonoff", so it will run first
+ (add-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose nil t)
+ (add-hook 'before-revert-hook 'eglot--signal-textDocument/didClose nil t)
+ (add-hook 'after-revert-hook 'eglot--after-revert-hook nil t)
+ (add-hook 'before-save-hook 'eglot--signal-textDocument/willSave nil t)
+ (add-hook 'after-save-hook 'eglot--signal-textDocument/didSave nil t)
+ (unless (eglot--stay-out-of-p 'xref)
+ (add-hook 'xref-backend-functions 'eglot-xref-backend nil t))
+ (add-hook 'completion-at-point-functions #'eglot-completion-at-point nil t)
+ (add-hook 'change-major-mode-hook #'eglot--managed-mode-off nil t)
+ (add-hook 'post-self-insert-hook 'eglot--post-self-insert-hook nil t)
+ (add-hook 'pre-command-hook 'eglot--pre-command-hook nil t)
+ (eglot--setq-saving eldoc-documentation-functions
+ '(eglot-signature-eldoc-function
+ eglot-hover-eldoc-function))
+ (eglot--setq-saving eldoc-documentation-strategy
+ #'eldoc-documentation-enthusiast)
+ (eglot--setq-saving xref-prompt-for-identifier nil)
+ (eglot--setq-saving flymake-diagnostic-functions '(eglot-flymake-backend))
+ (eglot--setq-saving company-backends '(company-capf))
+ (eglot--setq-saving company-tooltip-align-annotations t)
+ (unless (eglot--stay-out-of-p 'imenu)
+ (add-function :before-until (local 'imenu-create-index-function)
+ #'eglot-imenu))
+ (unless (eglot--stay-out-of-p 'flymake) (flymake-mode 1))
+ (unless (eglot--stay-out-of-p 'eldoc) (eldoc-mode 1))
+ (cl-pushnew (current-buffer) (eglot--managed-buffers
(eglot-current-server))))
+ (t
+ (remove-hook 'after-change-functions 'eglot--after-change t)
+ (remove-hook 'before-change-functions 'eglot--before-change t)
+ (remove-hook 'kill-buffer-hook #'eglot--managed-mode-off t)
+ (remove-hook 'kill-buffer-hook 'eglot--signal-textDocument/didClose t)
+ (remove-hook 'before-revert-hook 'eglot--signal-textDocument/didClose t)
+ (remove-hook 'after-revert-hook 'eglot--after-revert-hook t)
+ (remove-hook 'before-save-hook 'eglot--signal-textDocument/willSave t)
+ (remove-hook 'after-save-hook 'eglot--signal-textDocument/didSave t)
+ (remove-hook 'xref-backend-functions 'eglot-xref-backend t)
+ (remove-hook 'completion-at-point-functions #'eglot-completion-at-point t)
+ (remove-hook 'change-major-mode-hook #'eglot--managed-mode-off t)
+ (remove-hook 'post-self-insert-hook 'eglot--post-self-insert-hook t)
+ (remove-hook 'pre-command-hook 'eglot--pre-command-hook t)
+ (cl-loop for (var . saved-binding) in eglot--saved-bindings
+ do (set (make-local-variable var) saved-binding))
+ (remove-function (local 'imenu-create-index-function) #'eglot-imenu)
+ (when eglot--current-flymake-report-fn
+ (eglot--report-to-flymake nil)
+ (setq eglot--current-flymake-report-fn nil))
+ (let ((server eglot--cached-server))
+ (setq eglot--cached-server nil)
+ (when server
+ (setf (eglot--managed-buffers server)
+ (delq (current-buffer) (eglot--managed-buffers server)))
+ (when (and eglot-autoshutdown
+ (null (eglot--managed-buffers server)))
+ (eglot-shutdown server))))))
+ ;; Note: the public hook runs before the internal eglot--managed-mode-hook.
+ (run-hooks 'eglot-managed-mode-hook))
+
+(defun eglot--managed-mode-off ()
+ "Turn off `eglot--managed-mode' unconditionally."
+ (eglot--managed-mode -1))
+
+(defun eglot-current-server ()
+ "Return logical Eglot server for current buffer, nil if none."
+ (setq eglot--cached-server
+ (or eglot--cached-server
+ (cl-find major-mode
+ (gethash (eglot--current-project)
eglot--servers-by-project)
+ :key #'eglot--major-modes
+ :test #'memq)
+ (and eglot-extend-to-xref
+ buffer-file-name
+ (gethash (expand-file-name buffer-file-name)
+ eglot--servers-by-xrefed-file)))))
+
+(defun eglot--current-server-or-lose ()
+ "Return current logical Eglot server connection or error."
+ (or (eglot-current-server)
+ (jsonrpc-error "No current JSON-RPC connection")))
+
+(defvar-local eglot--diagnostics nil
+ "Flymake diagnostics for this buffer.")
+
+(defvar revert-buffer-preserve-modes)
+(defun eglot--after-revert-hook ()
+ "Eglot's `after-revert-hook'."
+ (when revert-buffer-preserve-modes (eglot--signal-textDocument/didOpen)))
+
+(defun eglot--maybe-activate-editing-mode ()
+ "Maybe activate `eglot--managed-mode'.
+
+If it is activated, also signal textDocument/didOpen."
+ (unless eglot--managed-mode
+ ;; Called when `revert-buffer-in-progress-p' is t but
+ ;; `revert-buffer-preserve-modes' is nil.
+ (when (and buffer-file-name (eglot-current-server))
+ (setq eglot--diagnostics nil)
+ (eglot--managed-mode)
+ (eglot--signal-textDocument/didOpen))))
+
+(add-hook 'find-file-hook 'eglot--maybe-activate-editing-mode)
+(add-hook 'after-change-major-mode-hook 'eglot--maybe-activate-editing-mode)
+
+(defun eglot-clear-status (server)
+ "Clear the last JSONRPC error for SERVER."
+ (interactive (list (eglot--current-server-or-lose)))
+ (setf (jsonrpc-last-error server) nil))
+
+
+;;; Mode-line, menu and other sugar
+;;;
+(defvar eglot--mode-line-format `(:eval (eglot--mode-line-format)))
+
+(put 'eglot--mode-line-format 'risky-local-variable t)
+
+(defun eglot--mouse-call (what)
+ "Make an interactive lambda for calling WHAT from mode-line."
+ (lambda (event)
+ (interactive "e")
+ (let ((start (event-start event))) (with-selected-window (posn-window
start)
+ (save-excursion
+ (goto-char (or (posn-point start)
+ (point)))
+ (call-interactively what)
+ (force-mode-line-update t))))))
+
+(defun eglot-manual () "Open documentation."
+ (declare (obsolete info "29.1"))
+ (interactive) (info "(eglot)"))
+
+(easy-menu-define eglot-menu nil "Eglot"
+ `("Eglot"
+ ;; Commands for getting information and customization.
+ ["Customize Eglot" (lambda () (interactive) (customize-group "eglot"))]
+ "--"
+ ;; xref like commands.
+ ["Find definitions" xref-find-definitions
+ :help "Find definitions of identifier at point"
+ :active (eglot--server-capable :definitionProvider)]
+ ["Find references" xref-find-references
+ :help "Find references to identifier at point"
+ :active (eglot--server-capable :referencesProvider)]
+ ["Find symbols in workspace (apropos)" xref-find-apropos
+ :help "Find symbols matching a query"
+ :active (eglot--server-capable :workspaceSymbolProvider)]
+ ["Find declaration" eglot-find-declaration
+ :help "Find declaration for identifier at point"
+ :active (eglot--server-capable :declarationProvider)]
+ ["Find implementation" eglot-find-implementation
+ :help "Find implementation for identifier at point"
+ :active (eglot--server-capable :implementationProvider)]
+ ["Find type definition" eglot-find-typeDefinition
+ :help "Find type definition for identifier at point"
+ :active (eglot--server-capable :typeDefinitionProvider)]
+ "--"
+ ;; LSP-related commands (mostly Eglot's own commands).
+ ["Rename symbol" eglot-rename
+ :active (eglot--server-capable :renameProvider)]
+ ["Format buffer" eglot-format-buffer
+ :active (eglot--server-capable :documentFormattingProvider)]
+ ["Format active region" eglot-format
+ :active (and (region-active-p)
+ (eglot--server-capable :documentRangeFormattingProvider))]
+ ["Show Flymake diagnostics for buffer" flymake-show-buffer-diagnostics]
+ ["Show Flymake diagnostics for project" flymake-show-project-diagnostics]
+ ["Show Eldoc documentation at point" eldoc-doc-buffer]
+ "--"
+ ["All possible code actions" eglot-code-actions
+ :active (eglot--server-capable :codeActionProvider)]
+ ["Organize imports" eglot-code-action-organize-imports
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Extract" eglot-code-action-extract
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Inline" eglot-code-action-inline
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Rewrite" eglot-code-action-rewrite
+ :visible (eglot--server-capable :codeActionProvider)]
+ ["Quickfix" eglot-code-action-quickfix
+ :visible (eglot--server-capable :codeActionProvider)]))
+
+(easy-menu-define eglot-server-menu nil "Monitor server communication"
+ '("Debugging the server communication"
+ ["Reconnect to server" eglot-reconnect]
+ ["Quit server" eglot-shutdown]
+ "--"
+ ["LSP events buffer" eglot-events-buffer]
+ ["Server stderr buffer" eglot-stderr-buffer]
+ ["Customize event buffer size"
+ (lambda ()
+ (interactive)
+ (customize-variable 'eglot-events-buffer-size))]))
+
+(defun eglot--mode-line-props (thing face defs &optional prepend)
+ "Helper for function `eglot--mode-line-format'.
+Uses THING, FACE, DEFS and PREPEND."
+ (cl-loop with map = (make-sparse-keymap)
+ for (elem . rest) on defs
+ for (key def help) = elem
+ do (define-key map `[mode-line ,key] (eglot--mouse-call def))
+ concat (format "%s: %s" key help) into blurb
+ when rest concat "\n" into blurb
+ finally (return `(:propertize ,thing
+ face ,face
+ keymap ,map help-echo ,(concat
prepend blurb)
+ mouse-face mode-line-highlight))))
+
+(defun eglot--mode-line-format ()
+ "Compose the Eglot's mode-line."
+ (let* ((server (eglot-current-server))
+ (nick (and server (eglot-project-nickname server)))
+ (pending (and server (hash-table-count
+ (jsonrpc--request-continuations server))))
+ (last-error (and server (jsonrpc-last-error server))))
+ (append
+ `(,(propertize
+ eglot-menu-string
+ 'face 'eglot-mode-line
+ 'mouse-face 'mode-line-highlight
+ 'help-echo "Eglot: Emacs LSP client\nmouse-1: Display minor mode menu"
+ 'keymap (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line down-mouse-1] eglot-menu)
+ map)))
+ (when nick
+ `(":"
+ ,(propertize
+ nick
+ 'face 'eglot-mode-line
+ 'mouse-face 'mode-line-highlight
+ 'help-echo (format "Project '%s'\nmouse-1: LSP server control menu"
nick)
+ 'keymap (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line down-mouse-1]
eglot-server-menu)
+ map))
+ ,@(when last-error
+ `("/" ,(eglot--mode-line-props
+ "error" 'compilation-mode-line-fail
+ '((mouse-3 eglot-clear-status "Clear this status"))
+ (format "An error occurred: %s\n" (plist-get last-error
+ :message)))))
+ ,@(when (cl-plusp pending)
+ `("/" ,(eglot--mode-line-props
+ (format "%d" pending) 'warning
+ '((mouse-3 eglot-forget-pending-continuations
+ "Forget pending continuations"))
+ "Number of outgoing, \
+still unanswered LSP requests to the server\n"))))))))
+
+(add-to-list 'mode-line-misc-info
+ `(eglot--managed-mode (" [" eglot--mode-line-format "] ")))
+
+
+;;; Flymake customization
+;;;
+(put 'eglot-note 'flymake-category 'flymake-note)
+(put 'eglot-warning 'flymake-category 'flymake-warning)
+(put 'eglot-error 'flymake-category 'flymake-error)
+
+(defalias 'eglot--make-diag 'flymake-make-diagnostic)
+(defalias 'eglot--diag-data 'flymake-diagnostic-data)
+
+(cl-loop for i from 1
+ for type in '(eglot-note eglot-warning eglot-error )
+ do (put type 'flymake-overlay-control
+ `((mouse-face . highlight)
+ (priority . ,(+ 50 i))
+ (keymap . ,(let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1]
+ (eglot--mouse-call 'eglot-code-actions))
+ map)))))
+
+
+;;; Protocol implementation (Requests, notifications, etc)
+;;;
+(cl-defmethod eglot-handle-notification
+ (_server method &key &allow-other-keys)
+ "Handle unknown notification."
+ (unless (or (string-prefix-p "$" (format "%s" method))
+ (not (memq 'disallow-unknown-methods eglot-strict-mode)))
+ (eglot--warn "Server sent unknown notification method `%s'" method)))
+
+(cl-defmethod eglot-handle-request
+ (_server method &key &allow-other-keys)
+ "Handle unknown request."
+ (when (memq 'disallow-unknown-methods eglot-strict-mode)
+ (jsonrpc-error "Unknown request method `%s'" method)))
+
+(cl-defmethod eglot-execute-command
+ (server command arguments)
+ "Execute COMMAND on SERVER with `:workspace/executeCommand'.
+COMMAND is a symbol naming the command."
+ (jsonrpc-request server :workspace/executeCommand
+ `(:command ,(format "%s" command) :arguments ,arguments)))
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql window/showMessage)) &key type message)
+ "Handle notification window/showMessage."
+ (eglot--message (propertize "Server reports (type=%s): %s"
+ 'face (if (<= type 1) 'error))
+ type message))
+
+(cl-defmethod eglot-handle-request
+ (_server (_method (eql window/showMessageRequest)) &key type message actions)
+ "Handle server request window/showMessageRequest."
+ (let* ((actions (append actions nil)) ;; gh#627
+ (label (completing-read
+ (concat
+ (format (propertize "[eglot] Server reports (type=%s): %s"
+ 'face (if (<= type 1) 'error))
+ type message)
+ "\nChoose an option: ")
+ (or (mapcar (lambda (obj) (plist-get obj :title)) actions)
+ '("OK"))
+ nil t (plist-get (elt actions 0) :title))))
+ (if label `(:title ,label) :null)))
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql window/logMessage)) &key _type _message)
+ "Handle notification window/logMessage.") ;; noop, use events buffer
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql telemetry/event)) &rest _any)
+ "Handle notification telemetry/event.") ;; noop, use events buffer
+
+(cl-defmethod eglot-handle-notification
+ (_server (_method (eql textDocument/publishDiagnostics)) &key uri diagnostics
+ &allow-other-keys) ; FIXME: doesn't respect `eglot-strict-mode'
+ "Handle notification publishDiagnostics."
+ (cl-flet ((eglot--diag-type (sev)
+ (cond ((null sev) 'eglot-error)
+ ((<= sev 1) 'eglot-error)
+ ((= sev 2) 'eglot-warning)
+ (t 'eglot-note)))
+ (mess (source code message)
+ (concat source (and code (format " [%s]" code)) ": " message)))
+ (if-let ((buffer (find-buffer-visiting (eglot--uri-to-path uri))))
+ (with-current-buffer buffer
+ (cl-loop
+ for diag-spec across diagnostics
+ collect (eglot--dbind ((Diagnostic) range code message severity
source tags)
+ diag-spec
+ (setq message (mess source code message))
+ (pcase-let
+ ((`(,beg . ,end) (eglot--range-region range)))
+ ;; Fallback to `flymake-diag-region' if server
+ ;; botched the range
+ (when (= beg end)
+ (if-let* ((st (plist-get range :start))
+ (diag-region
+ (flymake-diag-region
+ (current-buffer) (1+ (plist-get st :line))
+ (plist-get st :character))))
+ (setq beg (car diag-region) end (cdr diag-region))
+ (eglot--widening
+ (goto-char (point-min))
+ (setq beg
+ (line-beginning-position
+ (1+ (plist-get (plist-get range :start)
:line))))
+ (setq end
+ (line-end-position
+ (1+ (plist-get (plist-get range :end)
:line)))))))
+ (eglot--make-diag
+ (current-buffer) beg end
+ (eglot--diag-type severity)
+ message `((eglot-lsp-diag . ,diag-spec))
+ (when-let ((faces
+ (cl-loop for tag across tags
+ when (alist-get tag
eglot--tag-faces)
+ collect it)))
+ `((face . ,faces))))))
+ into diags
+ finally (cond ((and
+ ;; only add to current report if Flymake
+ ;; starts on idle-timer (github#958)
+ (not (null flymake-no-changes-timeout))
+ eglot--current-flymake-report-fn)
+ (eglot--report-to-flymake diags))
+ (t
+ (setq eglot--diagnostics diags)))))
+ (cl-loop
+ with path = (expand-file-name (eglot--uri-to-path uri))
+ for diag-spec across diagnostics
+ collect (eglot--dbind ((Diagnostic) code range message severity source)
diag-spec
+ (setq message (mess source code message))
+ (let* ((start (plist-get range :start))
+ (line (1+ (plist-get start :line)))
+ (char (1+ (plist-get start :character))))
+ (eglot--make-diag
+ path (cons line char) nil (eglot--diag-type severity)
message)))
+ into diags
+ finally
+ (setq flymake-list-only-diagnostics
+ (assoc-delete-all path flymake-list-only-diagnostics #'string=))
+ (push (cons path diags) flymake-list-only-diagnostics)))))
+
+(cl-defun eglot--register-unregister (server things how)
+ "Helper for `registerCapability'.
+THINGS are either registrations or unregisterations (sic)."
+ (cl-loop
+ for thing in (cl-coerce things 'list)
+ do (eglot--dbind ((Registration) id method registerOptions) thing
+ (apply (cl-ecase how
+ (register 'eglot-register-capability)
+ (unregister 'eglot-unregister-capability))
+ server (intern method) id registerOptions))))
+
+(cl-defmethod eglot-handle-request
+ (server (_method (eql client/registerCapability)) &key registrations)
+ "Handle server request client/registerCapability."
+ (eglot--register-unregister server registrations 'register))
+
+(cl-defmethod eglot-handle-request
+ (server (_method (eql client/unregisterCapability))
+ &key unregisterations) ;; XXX: "unregisterations" (sic)
+ "Handle server request client/unregisterCapability."
+ (eglot--register-unregister server unregisterations 'unregister))
+
+(cl-defmethod eglot-handle-request
+ (_server (_method (eql workspace/applyEdit)) &key _label edit)
+ "Handle server request workspace/applyEdit."
+ (eglot--apply-workspace-edit edit eglot-confirm-server-initiated-edits)
+ `(:applied t))
+
+(cl-defmethod eglot-handle-request
+ (server (_method (eql workspace/workspaceFolders)))
+ "Handle server request workspace/workspaceFolders."
+ (eglot-workspace-folders server))
+
+(defun eglot--TextDocumentIdentifier ()
+ "Compute TextDocumentIdentifier object for current buffer."
+ `(:uri ,(eglot--path-to-uri (or buffer-file-name
+ (ignore-errors
+ (buffer-file-name
+ (buffer-base-buffer)))))))
+
+(defvar-local eglot--versioned-identifier 0)
+
+(defun eglot--VersionedTextDocumentIdentifier ()
+ "Compute VersionedTextDocumentIdentifier object for current buffer."
+ (append (eglot--TextDocumentIdentifier)
+ `(:version ,eglot--versioned-identifier)))
+
+(defun eglot--TextDocumentItem ()
+ "Compute TextDocumentItem object for current buffer."
+ (append
+ (eglot--VersionedTextDocumentIdentifier)
+ (list :languageId
+ (eglot--language-id (eglot--current-server-or-lose))
+ :text
+ (eglot--widening
+ (buffer-substring-no-properties (point-min) (point-max))))))
+
+(defun eglot--TextDocumentPositionParams ()
+ "Compute TextDocumentPositionParams."
+ (list :textDocument (eglot--TextDocumentIdentifier)
+ :position (eglot--pos-to-lsp-position)))
+
+(defvar-local eglot--last-inserted-char nil
+ "If non-nil, value of the last inserted character in buffer.")
+
+(defun eglot--post-self-insert-hook ()
+ "Set `eglot--last-inserted-char', maybe call on-type-formatting."
+ (setq eglot--last-inserted-char last-input-event)
+ (let ((ot-provider (eglot--server-capable
:documentOnTypeFormattingProvider)))
+ (when (and ot-provider
+ (ignore-errors ; github#906, some LS's send empty strings
+ (or (eq last-input-event
+ (seq-first (plist-get ot-provider
:firstTriggerCharacter)))
+ (cl-find last-input-event
+ (plist-get ot-provider :moreTriggerCharacter)
+ :key #'seq-first))))
+ (eglot-format (point) nil last-input-event))))
+
+(defvar eglot--workspace-symbols-cache (make-hash-table :test #'equal)
+ "Cache of `workspace/Symbol' results used by `xref-find-definitions'.")
+
+(defun eglot--pre-command-hook ()
+ "Reset some temporary variables."
+ (clrhash eglot--workspace-symbols-cache)
+ (setq eglot--last-inserted-char nil))
+
+(defun eglot--CompletionParams ()
+ (append
+ (eglot--TextDocumentPositionParams)
+ `(:context
+ ,(if-let (trigger (and (characterp eglot--last-inserted-char)
+ (cl-find eglot--last-inserted-char
+ (eglot--server-capable :completionProvider
+ :triggerCharacters)
+ :key (lambda (str) (aref str 0))
+ :test #'char-equal)))
+ `(:triggerKind 2 :triggerCharacter ,trigger) `(:triggerKind 1)))))
+
+(defvar-local eglot--recent-changes nil
+ "Recent buffer changes as collected by `eglot--before-change'.")
+
+(cl-defmethod jsonrpc-connection-ready-p ((_server eglot-lsp-server) _what)
+ "Tell if SERVER is ready for WHAT in current buffer."
+ (and (cl-call-next-method) (not eglot--recent-changes)))
+
+(defvar-local eglot--change-idle-timer nil "Idle timer for didChange signals.")
+
+(defun eglot--before-change (beg end)
+ "Hook onto `before-change-functions' with BEG and END."
+ (when (listp eglot--recent-changes)
+ ;; Records BEG and END, crucially convert them into LSP
+ ;; (line/char) positions before that information is lost (because
+ ;; the after-change thingy doesn't know if newlines were
+ ;; deleted/added). Also record markers of BEG and END
+ ;; (github#259)
+ (push `(,(eglot--pos-to-lsp-position beg)
+ ,(eglot--pos-to-lsp-position end)
+ (,beg . ,(copy-marker beg nil))
+ (,end . ,(copy-marker end t)))
+ eglot--recent-changes)))
+
+(defun eglot--after-change (beg end pre-change-length)
+ "Hook onto `after-change-functions'.
+Records BEG, END and PRE-CHANGE-LENGTH locally."
+ (cl-incf eglot--versioned-identifier)
+ (pcase (and (listp eglot--recent-changes)
+ (car eglot--recent-changes))
+ (`(,lsp-beg ,lsp-end
+ (,b-beg . ,b-beg-marker)
+ (,b-end . ,b-end-marker))
+ ;; github#259 and github#367: With `capitalize-word' or somesuch,
+ ;; `before-change-functions' always records the whole word's
+ ;; `b-beg' and `b-end'. Similarly, when coalescing two lines
+ ;; into one, `fill-paragraph' they mark the end of the first line
+ ;; up to the end of the second line. In both situations, args
+ ;; received here contradict that information: `beg' and `end'
+ ;; will differ by 1 and will likely only encompass the letter
+ ;; that was capitalized or, in the sentence-joining situation,
+ ;; the replacement of the newline with a space. That's we keep
+ ;; markers _and_ positions so we're able to detect and correct
+ ;; this. We ignore `beg', `len' and `pre-change-len' and send
+ ;; "fuller" information about the region from the markers. I've
+ ;; also experimented with doing this unconditionally but it seems
+ ;; to break when newlines are added.
+ (if (and (= b-end b-end-marker) (= b-beg b-beg-marker)
+ (or (/= beg b-beg) (/= end b-end)))
+ (setcar eglot--recent-changes
+ `(,lsp-beg ,lsp-end ,(- b-end-marker b-beg-marker)
+ ,(buffer-substring-no-properties b-beg-marker
+ b-end-marker)))
+ (setcar eglot--recent-changes
+ `(,lsp-beg ,lsp-end ,pre-change-length
+ ,(buffer-substring-no-properties beg end)))))
+ (_ (setf eglot--recent-changes :emacs-messup)))
+ (when eglot--change-idle-timer (cancel-timer eglot--change-idle-timer))
+ (let ((buf (current-buffer)))
+ (setq eglot--change-idle-timer
+ (run-with-idle-timer
+ eglot-send-changes-idle-time
+ nil (lambda () (eglot--when-live-buffer buf
+ (when eglot--managed-mode
+ (eglot--signal-textDocument/didChange)
+ (setq eglot--change-idle-timer nil))))))))
+
+;; HACK! Launching a deferred sync request with outstanding changes is a
+;; bad idea, since that might lead to the request never having a
+;; chance to run, because `jsonrpc-connection-ready-p'.
+(advice-add #'jsonrpc-request :before
+ (cl-function (lambda (_proc _method _params &key
+ deferred &allow-other-keys)
+ (when (and eglot--managed-mode deferred)
+ (eglot--signal-textDocument/didChange))))
+ '((name . eglot--signal-textDocument/didChange)))
+
+(defvar-local eglot-workspace-configuration ()
+ "Configure LSP servers specifically for a given project.
+
+This variable's value should be a plist (SECTION VALUE ...).
+SECTION is a keyword naming a parameter section relevant to a
+particular server. VALUE is a plist or a primitive type
+converted to JSON also understood by that server.
+
+Instead of a plist, an alist ((SECTION . VALUE) ...) can be used
+instead, but this variant is less reliable and not recommended.
+
+This variable should be set as a directory-local variable. See
+info node `(emacs)Directory Variables' for various ways to do that.
+
+Here's an example value that establishes two sections relevant to
+the Pylsp and Gopls LSP servers:
+
+ (:pylsp (:plugins (:jedi_completion (:include_params t
+ :fuzzy t)
+ :pylint (:enabled :json-false)))
+ :gopls (:usePlaceholders t))
+
+The value of this variable can also be a unary function of a
+single argument, which will be a connected `eglot-lsp-server'
+instance. The function runs with `default-directory' set to the
+root of the current project. It should return an object of the
+format described above.")
+
+;;;###autoload
+(put 'eglot-workspace-configuration 'safe-local-variable 'listp)
+
+(defun eglot-show-workspace-configuration (&optional server)
+ "Dump `eglot-workspace-configuration' as JSON for debugging."
+ (interactive (list (and (eglot-current-server)
+ (eglot--read-server "Server configuration"
+ (eglot-current-server)))))
+ (let ((conf (eglot--workspace-configuration-plist server)))
+ (with-current-buffer (get-buffer-create "*EGLOT workspace configuration*")
+ (erase-buffer)
+ (insert (jsonrpc--json-encode conf))
+ (with-no-warnings
+ (require 'json)
+ (when (require 'json-mode nil t) (json-mode))
+ (json-pretty-print-buffer))
+ (pop-to-buffer (current-buffer)))))
+
+(defun eglot--workspace-configuration (server)
+ (if (functionp eglot-workspace-configuration)
+ (funcall eglot-workspace-configuration server)
+ eglot-workspace-configuration))
+
+(defun eglot--workspace-configuration-plist (server)
+ "Returns `eglot-workspace-configuration' suitable for serialization."
+ (let ((val (eglot--workspace-configuration server)))
+ (or (and (consp (car val))
+ (cl-loop for (section . v) in val
+ collect (if (keywordp section) section
+ (intern (format ":%s" section)))
+ collect v))
+ val)))
+
+(defun eglot-signal-didChangeConfiguration (server)
+ "Send a `:workspace/didChangeConfiguration' signal to SERVER.
+When called interactively, use the currently active server"
+ (interactive (list (eglot--current-server-or-lose)))
+ (jsonrpc-notify
+ server :workspace/didChangeConfiguration
+ (list
+ :settings
+ (or (eglot--workspace-configuration-plist server)
+ eglot--{}))))
+
+(cl-defmethod eglot-handle-request
+ (server (_method (eql workspace/configuration)) &key items)
+ "Handle server request workspace/configuration."
+ (apply #'vector
+ (mapcar
+ (eglot--lambda ((ConfigurationItem) scopeUri section)
+ (with-temp-buffer
+ (let* ((uri-path (eglot--uri-to-path scopeUri))
+ (default-directory
+ (if (and uri-path
+ (not (string-empty-p uri-path))
+ (file-directory-p uri-path))
+ (file-name-as-directory uri-path)
+ (project-root (eglot--project server)))))
+ (setq-local major-mode (car (eglot--major-modes server)))
+ (hack-dir-local-variables-non-file-buffer)
+ (cl-loop for (wsection o)
+ on (eglot--workspace-configuration-plist server)
+ by #'cddr
+ when (string=
+ (if (keywordp wsection)
+ (substring (symbol-name wsection) 1)
+ wsection)
+ section)
+ return o))))
+ items)))
+
+(defun eglot--signal-textDocument/didChange ()
+ "Send textDocument/didChange to server."
+ (when eglot--recent-changes
+ (let* ((server (eglot--current-server-or-lose))
+ (sync-capability (eglot--server-capable :textDocumentSync))
+ (sync-kind (if (numberp sync-capability) sync-capability
+ (plist-get sync-capability :change)))
+ (full-sync-p (or (eq sync-kind 1)
+ (eq :emacs-messup eglot--recent-changes))))
+ (jsonrpc-notify
+ server :textDocument/didChange
+ (list
+ :textDocument (eglot--VersionedTextDocumentIdentifier)
+ :contentChanges
+ (if full-sync-p
+ (vector `(:text ,(eglot--widening
+ (buffer-substring-no-properties (point-min)
+ (point-max)))))
+ (cl-loop for (beg end len text) in (reverse eglot--recent-changes)
+ ;; github#259: `capitalize-word' and commands based
+ ;; on `casify_region' will cause multiple duplicate
+ ;; empty entries in `eglot--before-change' calls
+ ;; without an `eglot--after-change' reciprocal.
+ ;; Weed them out here.
+ when (numberp len)
+ vconcat `[,(list :range `(:start ,beg :end ,end)
+ :rangeLength len :text text)]))))
+ (setq eglot--recent-changes nil)
+ (jsonrpc--call-deferred server))))
+
+(defun eglot--signal-textDocument/didOpen ()
+ "Send textDocument/didOpen to server."
+ (setq eglot--recent-changes nil eglot--versioned-identifier 0)
+ (jsonrpc-notify
+ (eglot--current-server-or-lose)
+ :textDocument/didOpen `(:textDocument ,(eglot--TextDocumentItem))))
+
+(defun eglot--signal-textDocument/didClose ()
+ "Send textDocument/didClose to server."
+ (with-demoted-errors
+ "[eglot] error sending textDocument/didClose: %s"
+ (jsonrpc-notify
+ (eglot--current-server-or-lose)
+ :textDocument/didClose `(:textDocument
,(eglot--TextDocumentIdentifier)))))
+
+(defun eglot--signal-textDocument/willSave ()
+ "Send textDocument/willSave to server."
+ (let ((server (eglot--current-server-or-lose))
+ (params `(:reason 1 :textDocument ,(eglot--TextDocumentIdentifier))))
+ (when (eglot--server-capable :textDocumentSync :willSave)
+ (jsonrpc-notify server :textDocument/willSave params))
+ (when (eglot--server-capable :textDocumentSync :willSaveWaitUntil)
+ (ignore-errors
+ (eglot--apply-text-edits
+ (jsonrpc-request server :textDocument/willSaveWaitUntil params
+ :timeout 0.5))))))
+
+(defun eglot--signal-textDocument/didSave ()
+ "Send textDocument/didSave to server."
+ (eglot--signal-textDocument/didChange)
+ (jsonrpc-notify
+ (eglot--current-server-or-lose)
+ :textDocument/didSave
+ (list
+ ;; TODO: Handle TextDocumentSaveRegistrationOptions to control this.
+ :text (buffer-substring-no-properties (point-min) (point-max))
+ :textDocument (eglot--TextDocumentIdentifier))))
+
+(defun eglot-flymake-backend (report-fn &rest _more)
+ "A Flymake backend for Eglot.
+Calls REPORT-FN (or arranges for it to be called) when the server
+publishes diagnostics. Between calls to this function, REPORT-FN
+may be called multiple times (respecting the protocol of
+`flymake-diagnostic-functions')."
+ (cond (eglot--managed-mode
+ (setq eglot--current-flymake-report-fn report-fn)
+ (eglot--report-to-flymake eglot--diagnostics))
+ (t
+ (funcall report-fn nil))))
+
+(defun eglot--report-to-flymake (diags)
+ "Internal helper for `eglot-flymake-backend'."
+ (save-restriction
+ (widen)
+ (funcall eglot--current-flymake-report-fn diags
+ ;; If the buffer hasn't changed since last
+ ;; call to the report function, flymake won't
+ ;; delete old diagnostics. Using :region
+ ;; keyword forces flymake to delete
+ ;; them (github#159).
+ :region (cons (point-min) (point-max))))
+ (setq eglot--diagnostics diags))
+
+(defun eglot-xref-backend () "Eglot xref backend." 'eglot)
+
+(defvar eglot--temp-location-buffers (make-hash-table :test #'equal)
+ "Helper variable for `eglot--collecting-xrefs'.")
+
+(defvar eglot-xref-lessp-function #'ignore
+ "Compare two `xref-item' objects for sorting.")
+
+(cl-defmacro eglot--collecting-xrefs ((collector) &rest body)
+ "Sort and handle xrefs collected with COLLECTOR in BODY."
+ (declare (indent 1) (debug (sexp &rest form)))
+ (let ((collected (cl-gensym "collected")))
+ `(unwind-protect
+ (let (,collected)
+ (cl-flet ((,collector (xref) (push xref ,collected)))
+ ,@body)
+ (setq ,collected (nreverse ,collected))
+ (sort ,collected eglot-xref-lessp-function))
+ (maphash (lambda (_uri buf) (kill-buffer buf))
eglot--temp-location-buffers)
+ (clrhash eglot--temp-location-buffers))))
+
+(defun eglot--xref-make-match (name uri range)
+ "Like `xref-make-match' but with LSP's NAME, URI and RANGE.
+Try to visit the target file for a richer summary line."
+ (pcase-let*
+ ((file (eglot--uri-to-path uri))
+ (visiting (or (find-buffer-visiting file)
+ (gethash uri eglot--temp-location-buffers)))
+ (collect (lambda ()
+ (eglot--widening
+ (pcase-let* ((`(,beg . ,end) (eglot--range-region range))
+ (bol (progn (goto-char beg)
(line-beginning-position)))
+ (substring (buffer-substring bol
(line-end-position)))
+ (hi-beg (- beg bol))
+ (hi-end (- (min (line-end-position) end) bol)))
+ (add-face-text-property hi-beg hi-end 'xref-match
+ t substring)
+ (list substring (line-number-at-pos (point) t)
+ (eglot-current-column) (- end beg))))))
+ (`(,summary ,line ,column ,length)
+ (cond
+ (visiting (with-current-buffer visiting (funcall collect)))
+ ((file-readable-p file) (with-current-buffer
+ (puthash uri (generate-new-buffer "
*temp*")
+ eglot--temp-location-buffers)
+ (insert-file-contents file)
+ (funcall collect)))
+ (t ;; fall back to the "dumb strategy"
+ (let* ((start (cl-getf range :start))
+ (line (1+ (cl-getf start :line)))
+ (start-pos (cl-getf start :character))
+ (end-pos (cl-getf (cl-getf range :end) :character)))
+ (list name line start-pos (- end-pos start-pos)))))))
+ (setf (gethash (expand-file-name file) eglot--servers-by-xrefed-file)
+ (eglot--current-server-or-lose))
+ (xref-make-match summary (xref-make-file-location file line column)
length)))
+
+(defun eglot--workspace-symbols (pat &optional buffer)
+ "Ask for :workspace/symbol on PAT, return list of formatted strings.
+If BUFFER, switch to it before."
+ (with-current-buffer (or buffer (current-buffer))
+ (unless (eglot--server-capable :workspaceSymbolProvider)
+ (eglot--error "This LSP server isn't a :workspaceSymbolProvider"))
+ (mapcar
+ (lambda (wss)
+ (eglot--dbind ((WorkspaceSymbol) name containerName kind) wss
+ (propertize
+ (format "%s%s %s"
+ (if (zerop (length containerName)) ""
+ (concat (propertize containerName 'face 'shadow) " "))
+ name
+ (propertize (alist-get kind eglot--symbol-kind-names
"Unknown")
+ 'face 'shadow))
+ 'eglot--lsp-workspaceSymbol wss)))
+ (jsonrpc-request (eglot--current-server-or-lose) :workspace/symbol
+ `(:query ,pat)))))
+
+(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql eglot)))
+ "Yet another tricky connection between LSP and Elisp completion semantics."
+ (let ((buf (current-buffer)) (cache eglot--workspace-symbols-cache))
+ (cl-labels ((refresh (pat) (eglot--workspace-symbols pat buf))
+ (lookup-1 (pat) ;; check cache, else refresh
+ (let ((probe (gethash pat cache :missing)))
+ (if (eq probe :missing) (puthash pat (refresh pat) cache)
+ probe)))
+ (lookup (pat)
+ (let ((res (lookup-1 pat))
+ (def (and (string= pat "") (gethash :default cache))))
+ (append def res nil)))
+ (score (c)
+ (cl-getf (get-text-property
+ 0 'eglot--lsp-workspaceSymbol c)
+ :score 0)))
+ (lambda (string _pred action)
+ (pcase action
+ (`metadata `(metadata
+ (cycle-sort-function
+ . ,(lambda (completions)
+ (cl-sort completions #'> :key #'score)))
+ (category . eglot-indirection-joy)))
+ (`(eglot--lsp-tryc . ,point) `(eglot--lsp-tryc . (,string . ,point)))
+ (`(eglot--lsp-allc . ,_point) `(eglot--lsp-allc . ,(lookup string)))
+ (_ nil))))))
+
+(defun eglot--recover-workspace-symbol-meta (string)
+ "Search `eglot--workspace-symbols-cache' for rich entry of STRING."
+ (catch 'found
+ (maphash (lambda (_k v)
+ (while (consp v)
+ ;; Like mess? Ask minibuffer.el about improper lists.
+ (when (equal (car v) string) (throw 'found (car v)))
+ (setq v (cdr v))))
+ eglot--workspace-symbols-cache)))
+
+(add-to-list 'completion-category-overrides
+ '(eglot-indirection-joy (styles . (eglot--lsp-backend-style))))
+
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql eglot)))
+ (let ((attempt
+ (and (xref--prompt-p this-command)
+ (puthash :default
+ (ignore-errors
+ (eglot--workspace-symbols (symbol-name
(symbol-at-point))))
+ eglot--workspace-symbols-cache))))
+ (if attempt (car attempt) "LSP identifier at point")))
+
+(defvar eglot--lsp-xref-refs nil
+ "`xref' objects for overriding `xref-backend-references''s.")
+
+(cl-defun eglot--lsp-xrefs-for-method (method &key extra-params capability)
+ "Make `xref''s for METHOD, EXTRA-PARAMS, check CAPABILITY."
+ (unless (eglot--server-capable
+ (or capability
+ (intern
+ (format ":%sProvider"
+ (cadr (split-string (symbol-name method)
+ "/"))))))
+ (eglot--error "Sorry, this server doesn't do %s" method))
+ (let ((response
+ (jsonrpc-request
+ (eglot--current-server-or-lose)
+ method (append (eglot--TextDocumentPositionParams) extra-params))))
+ (eglot--collecting-xrefs (collect)
+ (mapc
+ (lambda (loc-or-loc-link)
+ (let ((sym-name (symbol-name (symbol-at-point))))
+ (eglot--dcase loc-or-loc-link
+ (((LocationLink) targetUri targetSelectionRange)
+ (collect (eglot--xref-make-match sym-name
+ targetUri
targetSelectionRange)))
+ (((Location) uri range)
+ (collect (eglot--xref-make-match sym-name
+ uri range))))))
+ (if (vectorp response) response (and response (list response)))))))
+
+(cl-defun eglot--lsp-xref-helper (method &key extra-params capability )
+ "Helper for `eglot-find-declaration' & friends."
+ (let ((eglot--lsp-xref-refs (eglot--lsp-xrefs-for-method
+ method
+ :extra-params extra-params
+ :capability capability)))
+ (if eglot--lsp-xref-refs
+ (xref-find-references "LSP identifier at point.")
+ (eglot--message "%s returned no references" method))))
+
+(defun eglot-find-declaration ()
+ "Find declaration for SYM, the identifier at point."
+ (interactive)
+ (eglot--lsp-xref-helper :textDocument/declaration))
+
+(defun eglot-find-implementation ()
+ "Find implementation for SYM, the identifier at point."
+ (interactive)
+ (eglot--lsp-xref-helper :textDocument/implementation))
+
+(defun eglot-find-typeDefinition ()
+ "Find type definition for SYM, the identifier at point."
+ (interactive)
+ (eglot--lsp-xref-helper :textDocument/typeDefinition))
+
+(cl-defmethod xref-backend-definitions ((_backend (eql eglot)) id)
+ (let ((probe (eglot--recover-workspace-symbol-meta id)))
+ (if probe
+ (eglot--dbind ((WorkspaceSymbol) name location)
+ (get-text-property 0 'eglot--lsp-workspaceSymbol probe)
+ (eglot--dbind ((Location) uri range) location
+ (list (eglot--xref-make-match name uri range))))
+ (eglot--lsp-xrefs-for-method :textDocument/definition))))
+
+(cl-defmethod xref-backend-references ((_backend (eql eglot)) _identifier)
+ (or
+ eglot--lsp-xref-refs
+ (eglot--lsp-xrefs-for-method
+ :textDocument/references :extra-params `(:context (:includeDeclaration
t)))))
+
+(cl-defmethod xref-backend-apropos ((_backend (eql eglot)) pattern)
+ (when (eglot--server-capable :workspaceSymbolProvider)
+ (eglot--collecting-xrefs (collect)
+ (mapc
+ (eglot--lambda ((SymbolInformation) name location)
+ (eglot--dbind ((Location) uri range) location
+ (collect (eglot--xref-make-match name uri range))))
+ (jsonrpc-request (eglot--current-server-or-lose)
+ :workspace/symbol
+ `(:query ,pattern))))))
+
+(defun eglot-format-buffer ()
+ "Format contents of current buffer."
+ (interactive)
+ (eglot-format nil nil))
+
+(defun eglot-format (&optional beg end on-type-format)
+ "Format region BEG END.
+If either BEG or END is nil, format entire buffer.
+Interactively, format active region, or entire buffer if region
+is not active.
+
+If non-nil, ON-TYPE-FORMAT is a character just inserted at BEG
+for which LSP on-type-formatting should be requested."
+ (interactive (and (region-active-p) (list (region-beginning) (region-end))))
+ (pcase-let ((`(,method ,cap ,args)
+ (cond
+ ((and beg on-type-format)
+ `(:textDocument/onTypeFormatting
+ :documentOnTypeFormattingProvider
+ ,`(:position ,(eglot--pos-to-lsp-position beg)
+ :ch ,(string on-type-format))))
+ ((and beg end)
+ `(:textDocument/rangeFormatting
+ :documentRangeFormattingProvider
+ (:range ,(list :start (eglot--pos-to-lsp-position beg)
+ :end (eglot--pos-to-lsp-position end)))))
+ (t
+ '(:textDocument/formatting :documentFormattingProvider
nil)))))
+ (unless (eglot--server-capable cap)
+ (eglot--error "Server can't format!"))
+ (eglot--apply-text-edits
+ (jsonrpc-request
+ (eglot--current-server-or-lose)
+ method
+ (cl-list*
+ :textDocument (eglot--TextDocumentIdentifier)
+ :options (list :tabSize tab-width
+ :insertSpaces (if indent-tabs-mode :json-false t)
+ :insertFinalNewline (if require-final-newline t
:json-false)
+ :trimFinalNewlines (if delete-trailing-lines t
:json-false))
+ args)
+ :deferred method))))
+
+(defun eglot-completion-at-point ()
+ "Eglot's `completion-at-point' function."
+ ;; Commit logs for this function help understand what's going on.
+ (when-let (completion-capability (eglot--server-capable :completionProvider))
+ (let* ((server (eglot--current-server-or-lose))
+ (sort-completions
+ (lambda (completions)
+ (cl-sort completions
+ #'string-lessp
+ :key (lambda (c)
+ (or (plist-get
+ (get-text-property 0 'eglot--lsp-item c)
+ :sortText)
+ "")))))
+ (metadata `(metadata (category . eglot)
+ (display-sort-function . ,sort-completions)))
+ resp items (cached-proxies :none)
+ (proxies
+ (lambda ()
+ (if (listp cached-proxies) cached-proxies
+ (setq resp
+ (jsonrpc-request server
+ :textDocument/completion
+ (eglot--CompletionParams)
+ :deferred :textDocument/completion
+ :cancel-on-input t))
+ (setq items (append
+ (if (vectorp resp) resp (plist-get resp :items))
+ nil))
+ (setq cached-proxies
+ (mapcar
+ (jsonrpc-lambda
+ (&rest item &key label insertText insertTextFormat
+ &allow-other-keys)
+ (let ((proxy
+ (cond ((and (eql insertTextFormat 2)
+ (eglot--snippet-expansion-fn))
+ (string-trim-left label))
+ ((and insertText
+ (not (string-empty-p insertText)))
+ insertText)
+ (t
+ (string-trim-left label)))))
+ (unless (zerop (length proxy))
+ (put-text-property 0 1 'eglot--lsp-item item
proxy))
+ proxy))
+ items)))))
+ (resolved (make-hash-table))
+ (resolve-maybe
+ ;; Maybe completion/resolve JSON object `lsp-comp' into
+ ;; another JSON object, if at all possible. Otherwise,
+ ;; just return lsp-comp.
+ (lambda (lsp-comp)
+ (or (gethash lsp-comp resolved)
+ (setf (gethash lsp-comp resolved)
+ (if (and (eglot--server-capable :completionProvider
+ :resolveProvider)
+ (plist-get lsp-comp :data))
+ (jsonrpc-request server :completionItem/resolve
+ lsp-comp :cancel-on-input t)
+ lsp-comp)))))
+ (bounds (bounds-of-thing-at-point 'symbol)))
+ (list
+ (or (car bounds) (point))
+ (or (cdr bounds) (point))
+ (lambda (probe pred action)
+ (cond
+ ((eq action 'metadata) metadata) ; metadata
+ ((eq action 'lambda) ; test-completion
+ (test-completion probe (funcall proxies)))
+ ((eq (car-safe action) 'boundaries) nil) ; boundaries
+ ((null action) ; try-completion
+ (try-completion probe (funcall proxies)))
+ ((eq action t) ; all-completions
+ (all-completions
+ ""
+ (funcall proxies)
+ (lambda (proxy)
+ (let* ((item (get-text-property 0 'eglot--lsp-item proxy))
+ (filterText (plist-get item :filterText)))
+ (and (or (null pred) (funcall pred proxy))
+ (string-prefix-p
+ probe (or filterText proxy)
completion-ignore-case))))))))
+ :annotation-function
+ (lambda (proxy)
+ (eglot--dbind ((CompletionItem) detail kind)
+ (get-text-property 0 'eglot--lsp-item proxy)
+ (let* ((detail (and (stringp detail)
+ (not (string= detail ""))
+ detail))
+ (annotation
+ (or detail
+ (cdr (assoc kind eglot--kind-names)))))
+ (when annotation
+ (concat " "
+ (propertize annotation
+ 'face 'font-lock-function-name-face))))))
+ :company-kind
+ ;; Associate each lsp-item with a lsp-kind symbol.
+ (lambda (proxy)
+ (when-let* ((lsp-item (get-text-property 0 'eglot--lsp-item proxy))
+ (kind (alist-get (plist-get lsp-item :kind)
+ eglot--kind-names)))
+ (intern (downcase kind))))
+ :company-deprecated
+ (lambda (proxy)
+ (when-let ((lsp-item (get-text-property 0 'eglot--lsp-item proxy)))
+ (or (seq-contains-p (plist-get lsp-item :tags)
+ 1)
+ (eq t (plist-get lsp-item :deprecated)))))
+ :company-docsig
+ ;; FIXME: autoImportText is specific to the pyright language server
+ (lambda (proxy)
+ (when-let* ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy))
+ (data (plist-get (funcall resolve-maybe lsp-comp) :data))
+ (import-text (plist-get data :autoImportText)))
+ import-text))
+ :company-doc-buffer
+ (lambda (proxy)
+ (let* ((documentation
+ (let ((lsp-comp (get-text-property 0 'eglot--lsp-item proxy)))
+ (plist-get (funcall resolve-maybe lsp-comp)
:documentation)))
+ (formatted (and documentation
+ (eglot--format-markup documentation))))
+ (when formatted
+ (with-current-buffer (get-buffer-create " *eglot doc*")
+ (erase-buffer)
+ (insert formatted)
+ (current-buffer)))))
+ :company-require-match 'never
+ :company-prefix-length
+ (save-excursion
+ (when (car bounds) (goto-char (car bounds)))
+ (when (listp completion-capability)
+ (looking-back
+ (regexp-opt
+ (cl-coerce (cl-getf completion-capability :triggerCharacters)
'list))
+ (line-beginning-position))))
+ :exit-function
+ (lambda (proxy status)
+ (when (memq status '(finished exact))
+ ;; To assist in using this whole `completion-at-point'
+ ;; function inside `completion-in-region', ensure the exit
+ ;; function runs in the buffer where the completion was
+ ;; triggered from. This should probably be in Emacs itself.
+ ;; (github#505)
+ (with-current-buffer (if (minibufferp)
+ (window-buffer
(minibuffer-selected-window))
+ (current-buffer))
+ (eglot--dbind ((CompletionItem) insertTextFormat
+ insertText textEdit additionalTextEdits label)
+ (funcall
+ resolve-maybe
+ (or (get-text-property 0 'eglot--lsp-item proxy)
+ ;; When selecting from the *Completions*
+ ;; buffer, `proxy' won't have any properties.
+ ;; A lookup should fix that (github#148)
+ (get-text-property
+ 0 'eglot--lsp-item
+ (cl-find proxy (funcall proxies) :test #'string=))))
+ (let ((snippet-fn (and (eql insertTextFormat 2)
+ (eglot--snippet-expansion-fn))))
+ (cond (textEdit
+ ;; Undo (yes, undo) the newly inserted completion.
+ ;; If before completion the buffer was "foo.b" and
+ ;; now is "foo.bar", `proxy' will be "bar". We
+ ;; want to delete only "ar" (`proxy' minus the
+ ;; symbol whose bounds we've calculated before)
+ ;; (github#160).
+ (delete-region (+ (- (point) (length proxy))
+ (if bounds
+ (- (cdr bounds) (car bounds))
+ 0))
+ (point))
+ (eglot--dbind ((TextEdit) range newText) textEdit
+ (pcase-let ((`(,beg . ,end)
+ (eglot--range-region range)))
+ (delete-region beg end)
+ (goto-char beg)
+ (funcall (or snippet-fn #'insert) newText))))
+ (snippet-fn
+ ;; A snippet should be inserted, but using plain
+ ;; `insertText'. This requires us to delete the
+ ;; whole completion, since `insertText' is the full
+ ;; completion's text.
+ (delete-region (- (point) (length proxy)) (point))
+ (funcall snippet-fn (or insertText label))))
+ (when (cl-plusp (length additionalTextEdits))
+ (eglot--apply-text-edits additionalTextEdits)))
+ (eglot--signal-textDocument/didChange)
+ (eldoc)))))))))
+
+(defun eglot--hover-info (contents &optional _range)
+ (mapconcat #'eglot--format-markup
+ (if (vectorp contents) contents (list contents)) "\n"))
+
+(defun eglot--sig-info (sigs active-sig sig-help-active-param)
+ (cl-loop
+ for (sig . moresigs) on (append sigs nil) for i from 0
+ concat
+ (eglot--dbind ((SignatureInformation) label documentation parameters
activeParameter) sig
+ (with-temp-buffer
+ (save-excursion (insert label))
+ (let ((active-param (or activeParameter sig-help-active-param))
+ params-start params-end)
+ ;; Ad-hoc attempt to parse label as <name>(<params>)
+ (when (looking-at "\\([^(]*\\)(\\([^)]+\\))")
+ (setq params-start (match-beginning 2) params-end (match-end 2))
+ (add-face-text-property (match-beginning 1) (match-end 1)
+ 'font-lock-function-name-face))
+ (when (eql i active-sig)
+ ;; Decide whether to add one-line-summary to signature line
+ (when (and (stringp documentation)
+ (string-match "[[:space:]]*\\([^.\r\n]+[.]?\\)"
+ documentation))
+ (setq documentation (match-string 1 documentation))
+ (unless (string-prefix-p (string-trim documentation) label)
+ (goto-char (point-max))
+ (insert ": " (eglot--format-markup documentation))))
+ ;; Decide what to do with the active parameter...
+ (when (and (eql i active-sig) active-param
+ (< -1 active-param (length parameters)))
+ (eglot--dbind ((ParameterInformation) label documentation)
+ (aref parameters active-param)
+ ;; ...perhaps highlight it in the formals list
+ (when params-start
+ (goto-char params-start)
+ (pcase-let
+ ((`(,beg ,end)
+ (if (stringp label)
+ (let ((case-fold-search nil))
+ (and (re-search-forward
+ (concat "\\<" (regexp-quote label) "\\>")
+ params-end t)
+ (list (match-beginning 0) (match-end 0))))
+ (mapcar #'1+ (append label nil)))))
+ (if (and beg end)
+ (add-face-text-property
+ beg end
+ 'eldoc-highlight-function-argument))))
+ ;; ...and/or maybe add its doc on a line by its own.
+ (when documentation
+ (goto-char (point-max))
+ (insert "\n"
+ (propertize
+ (if (stringp label)
+ label
+ (apply #'buffer-substring (mapcar #'1+ label)))
+ 'face 'eldoc-highlight-function-argument)
+ ": " (eglot--format-markup documentation))))))
+ (buffer-string))))
+ when moresigs concat "\n"))
+
+(defun eglot-signature-eldoc-function (cb)
+ "A member of `eldoc-documentation-functions', for signatures."
+ (when (eglot--server-capable :signatureHelpProvider)
+ (let ((buf (current-buffer)))
+ (jsonrpc-async-request
+ (eglot--current-server-or-lose)
+ :textDocument/signatureHelp (eglot--TextDocumentPositionParams)
+ :success-fn
+ (eglot--lambda ((SignatureHelp)
+ signatures activeSignature activeParameter)
+ (eglot--when-buffer-window buf
+ (funcall cb
+ (unless (seq-empty-p signatures)
+ (eglot--sig-info signatures
+ activeSignature
+ activeParameter)))))
+ :deferred :textDocument/signatureHelp))
+ t))
+
+(defun eglot-hover-eldoc-function (cb)
+ "A member of `eldoc-documentation-functions', for hover."
+ (when (eglot--server-capable :hoverProvider)
+ (let ((buf (current-buffer)))
+ (jsonrpc-async-request
+ (eglot--current-server-or-lose)
+ :textDocument/hover (eglot--TextDocumentPositionParams)
+ :success-fn (eglot--lambda ((Hover) contents range)
+ (eglot--when-buffer-window buf
+ (let ((info (unless (seq-empty-p contents)
+ (eglot--hover-info contents range))))
+ (funcall cb info :buffer t))))
+ :deferred :textDocument/hover))
+ (eglot--highlight-piggyback cb)
+ t))
+
+(defvar eglot--highlights nil "Overlays for textDocument/documentHighlight.")
+
+(defun eglot--highlight-piggyback (_cb)
+ "Request and handle `:textDocument/documentHighlight'."
+ ;; FIXME: Obviously, this is just piggy backing on eldoc's calls for
+ ;; convenience, as shown by the fact that we just ignore cb.
+ (let ((buf (current-buffer)))
+ (when (eglot--server-capable :documentHighlightProvider)
+ (jsonrpc-async-request
+ (eglot--current-server-or-lose)
+ :textDocument/documentHighlight (eglot--TextDocumentPositionParams)
+ :success-fn
+ (lambda (highlights)
+ (mapc #'delete-overlay eglot--highlights)
+ (setq eglot--highlights
+ (eglot--when-buffer-window buf
+ (mapcar
+ (eglot--lambda ((DocumentHighlight) range)
+ (pcase-let ((`(,beg . ,end)
+ (eglot--range-region range)))
+ (let ((ov (make-overlay beg end)))
+ (overlay-put ov 'face 'eglot-highlight-symbol-face)
+ (overlay-put ov 'modification-hooks
+ `(,(lambda (o &rest _) (delete-overlay
o))))
+ ov)))
+ highlights))))
+ :deferred :textDocument/documentHighlight)
+ nil)))
+
+(defun eglot-imenu ()
+ "Eglot's `imenu-create-index-function'.
+Returns a list as described in docstring of `imenu--index-alist'."
+ (cl-labels
+ ((unfurl (obj)
+ (eglot--dcase obj
+ (((SymbolInformation)) (list obj))
+ (((DocumentSymbol) name children)
+ (cons obj
+ (mapcar
+ (lambda (c)
+ (plist-put
+ c :containerName
+ (let ((existing (plist-get c :containerName)))
+ (if existing (format "%s::%s" name existing)
+ name))))
+ (mapcan #'unfurl children)))))))
+ (mapcar
+ (pcase-lambda (`(,kind . ,objs))
+ (cons
+ (alist-get kind eglot--symbol-kind-names "Unknown")
+ (mapcan (pcase-lambda (`(,container . ,objs))
+ (let ((elems (mapcar
+ (lambda (obj)
+ (cons (plist-get obj :name)
+ (car (eglot--range-region
+ (eglot--dcase obj
+ (((SymbolInformation) location)
+ (plist-get location :range))
+ (((DocumentSymbol)
selectionRange)
+ selectionRange))))))
+ objs)))
+ (if container (list (cons container elems)) elems)))
+ (seq-group-by
+ (lambda (e) (plist-get e :containerName)) objs))))
+ (seq-group-by
+ (lambda (obj) (plist-get obj :kind))
+ (mapcan #'unfurl
+ (jsonrpc-request (eglot--current-server-or-lose)
+ :textDocument/documentSymbol
+ `(:textDocument
+ ,(eglot--TextDocumentIdentifier))
+ :cancel-on-input non-essential))))))
+
+(defun eglot--apply-text-edits (edits &optional version)
+ "Apply EDITS for current buffer if at VERSION, or if it's nil."
+ (unless (or (not version) (equal version eglot--versioned-identifier))
+ (jsonrpc-error "Edits on `%s' require version %d, you have %d"
+ (current-buffer) version eglot--versioned-identifier))
+ (atomic-change-group
+ (let* ((change-group (prepare-change-group))
+ (howmany (length edits))
+ (reporter (make-progress-reporter
+ (format "[eglot] applying %s edits to `%s'..."
+ howmany (current-buffer))
+ 0 howmany))
+ (done 0))
+ (mapc (pcase-lambda (`(,newText ,beg . ,end))
+ (let ((source (current-buffer)))
+ (with-temp-buffer
+ (insert newText)
+ (let ((temp (current-buffer)))
+ (with-current-buffer source
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (replace-buffer-contents temp)))
+ (progress-reporter-update reporter (cl-incf done)))))))
+ (mapcar (eglot--lambda ((TextEdit) range newText)
+ (cons newText (eglot--range-region range 'markers)))
+ (reverse edits)))
+ (undo-amalgamate-change-group change-group)
+ (progress-reporter-done reporter))))
+
+(defun eglot--apply-workspace-edit (wedit &optional confirm)
+ "Apply the workspace edit WEDIT. If CONFIRM, ask user first."
+ (eglot--dbind ((WorkspaceEdit) changes documentChanges) wedit
+ (let ((prepared
+ (mapcar (eglot--lambda ((TextDocumentEdit) textDocument edits)
+ (eglot--dbind ((VersionedTextDocumentIdentifier) uri
version)
+ textDocument
+ (list (eglot--uri-to-path uri) edits version)))
+ documentChanges)))
+ (unless (and changes documentChanges)
+ ;; We don't want double edits, and some servers send both
+ ;; changes and documentChanges. This unless ensures that we
+ ;; prefer documentChanges over changes.
+ (cl-loop for (uri edits) on changes by #'cddr
+ do (push (list (eglot--uri-to-path uri) edits) prepared)))
+ (if (or confirm
+ (cl-notevery #'find-buffer-visiting
+ (mapcar #'car prepared)))
+ (unless (y-or-n-p
+ (format "[eglot] Server wants to edit:\n %s\n Proceed? "
+ (mapconcat #'identity (mapcar #'car prepared) "\n
")))
+ (jsonrpc-error "User canceled server edit")))
+ (cl-loop for edit in prepared
+ for (path edits version) = edit
+ do (with-current-buffer (find-file-noselect path)
+ (eglot--apply-text-edits edits version))
+ finally (eldoc) (eglot--message "Edit successful!")))))
+
+(defun eglot-rename (newname)
+ "Rename the current symbol to NEWNAME."
+ (interactive
+ (list (read-from-minibuffer
+ (format "Rename `%s' to: " (or (thing-at-point 'symbol t)
+ "unknown symbol"))
+ nil nil nil nil
+ (symbol-name (symbol-at-point)))))
+ (unless (eglot--server-capable :renameProvider)
+ (eglot--error "Server can't rename!"))
+ (eglot--apply-workspace-edit
+ (jsonrpc-request (eglot--current-server-or-lose)
+ :textDocument/rename
`(,@(eglot--TextDocumentPositionParams)
+ :newName ,newname))
+ current-prefix-arg))
+
+(defun eglot--region-bounds ()
+ "Region bounds if active, else bounds of things at point."
+ (if (use-region-p) `(,(region-beginning) ,(region-end))
+ (let ((boftap (bounds-of-thing-at-point 'sexp)))
+ (list (car boftap) (cdr boftap)))))
+
+(defun eglot-code-actions (beg &optional end action-kind interactive)
+ "Find LSP code actions of type ACTION-KIND between BEG and END.
+Interactively, offer to execute them.
+If ACTION-KIND is nil, consider all kinds of actions.
+Interactively, default BEG and END to region's bounds else BEG is
+point and END is nil, which results in a request for code actions
+at point. With prefix argument, prompt for ACTION-KIND."
+ (interactive
+ `(,@(eglot--region-bounds)
+ ,(and current-prefix-arg
+ (completing-read "[eglot] Action kind: "
+ '("quickfix" "refactor.extract" "refactor.inline"
+ "refactor.rewrite" "source.organizeImports")))
+ t))
+ (unless (or (not interactive)
+ (eglot--server-capable :codeActionProvider))
+ (eglot--error "Server can't execute code actions!"))
+ (let* ((server (eglot--current-server-or-lose))
+ (actions
+ (jsonrpc-request
+ server
+ :textDocument/codeAction
+ (list :textDocument (eglot--TextDocumentIdentifier)
+ :range (list :start (eglot--pos-to-lsp-position beg)
+ :end (eglot--pos-to-lsp-position end))
+ :context
+ `(:diagnostics
+ [,@(cl-loop for diag in (flymake-diagnostics beg end)
+ when (cdr (assoc 'eglot-lsp-diag
+ (eglot--diag-data diag)))
+ collect it)]
+ ,@(when action-kind `(:only [,action-kind]))))
+ :deferred t))
+ ;; Redo filtering, in case the `:only' didn't go through.
+ (actions (cl-loop for a across actions
+ when (or (not action-kind)
+ (equal action-kind (plist-get a :kind)))
+ collect a)))
+ (if interactive
+ (eglot--read-execute-code-action actions server action-kind)
+ actions)))
+
+(defun eglot--read-execute-code-action (actions server &optional action-kind)
+ "Helper for interactive calls to `eglot-code-actions'."
+ (let* ((menu-items
+ (or (cl-loop for a in actions
+ collect (cons (plist-get a :title) a))
+ (apply #'eglot--error
+ (if action-kind `("No \"%s\" code actions here"
,action-kind)
+ `("No code actions here")))))
+ (preferred-action (cl-find-if
+ (lambda (menu-item)
+ (plist-get (cdr menu-item) :isPreferred))
+ menu-items))
+ (default-action (car (or preferred-action (car menu-items))))
+ (chosen (if (and action-kind (null (cadr menu-items)))
+ (cdr (car menu-items))
+ (if (listp last-nonmenu-event)
+ (x-popup-menu last-nonmenu-event `("Eglot code actions:"
+ ("dummy"
,@menu-items)))
+ (cdr (assoc (completing-read
+ (format "[eglot] Pick an action (default
%s): "
+ default-action)
+ menu-items nil t nil nil default-action)
+ menu-items))))))
+ (eglot--dcase chosen
+ (((Command) command arguments)
+ (eglot-execute-command server (intern command) arguments))
+ (((CodeAction) edit command)
+ (when edit (eglot--apply-workspace-edit edit))
+ (when command
+ (eglot--dbind ((Command) command arguments) command
+ (eglot-execute-command server (intern command) arguments)))))))
+
+(defmacro eglot--code-action (name kind)
+ "Define NAME to execute KIND code action."
+ `(defun ,name (beg &optional end)
+ ,(format "Execute `%s' code actions between BEG and END." kind)
+ (interactive (eglot--region-bounds))
+ (eglot-code-actions beg end ,kind)))
+
+(eglot--code-action eglot-code-action-organize-imports
"source.organizeImports")
+(eglot--code-action eglot-code-action-extract "refactor.extract")
+(eglot--code-action eglot-code-action-inline "refactor.inline")
+(eglot--code-action eglot-code-action-rewrite "refactor.rewrite")
+(eglot--code-action eglot-code-action-quickfix "quickfix")
+
+
+;;; Dynamic registration
+;;;
+(cl-defmethod eglot-register-capability
+ (server (method (eql workspace/didChangeWatchedFiles)) id &key watchers)
+ "Handle dynamic registration of workspace/didChangeWatchedFiles."
+ (eglot-unregister-capability server method id)
+ (let* (success
+ (globs (mapcar
+ (eglot--lambda ((FileSystemWatcher) globPattern kind)
+ (cons (eglot--glob-compile globPattern t t)
+ ;; the default "7" means bitwise OR of
+ ;; WatchKind.Create (1), WatchKind.Change
+ ;; (2), WatchKind.Delete (4)
+ (or kind 7)))
+ watchers))
+ (dirs-to-watch
+ (delete-dups (mapcar #'file-name-directory
+ (project-files
+ (eglot--project server))))))
+ (cl-labels
+ ((handle-event
+ (event)
+ (pcase-let* ((`(,desc ,action ,file ,file1) event)
+ (action-type (cl-case action
+ (created 1) (changed 2) (deleted 3)))
+ (action-bit (when action-type
+ (ash 1 (1- action-type)))))
+ (cond
+ ((and (memq action '(created changed deleted))
+ (cl-loop for (glob . kind-bitmask) in globs
+ thereis (and (> (logand kind-bitmask action-bit) 0)
+ (funcall glob file))))
+ (jsonrpc-notify
+ server :workspace/didChangeWatchedFiles
+ `(:changes ,(vector `(:uri ,(eglot--path-to-uri file)
+ :type ,action-type)))))
+ ((eq action 'renamed)
+ (handle-event `(,desc 'deleted ,file))
+ (handle-event `(,desc 'created ,file1)))))))
+ (unwind-protect
+ (progn
+ (dolist (dir dirs-to-watch)
+ (push (file-notify-add-watch dir '(change) #'handle-event)
+ (gethash id (eglot--file-watches server))))
+ (setq
+ success
+ `(:message ,(format "OK, watching %s directories in %s watchers"
+ (length dirs-to-watch) (length watchers)))))
+ (unless success
+ (eglot-unregister-capability server method id))))))
+
+(cl-defmethod eglot-unregister-capability
+ (server (_method (eql workspace/didChangeWatchedFiles)) id)
+ "Handle dynamic unregistration of workspace/didChangeWatchedFiles."
+ (mapc #'file-notify-rm-watch (gethash id (eglot--file-watches server)))
+ (remhash id (eglot--file-watches server))
+ (list t "OK"))
+
+
+;;; Glob heroics
+;;;
+(defun eglot--glob-parse (glob)
+ "Compute list of (STATE-SYM EMITTER-FN PATTERN)."
+ (with-temp-buffer
+ (save-excursion (insert glob))
+ (cl-loop
+ with grammar = '((:** "\\*\\*/?" eglot--glob-emit-**)
+ (:* "\\*" eglot--glob-emit-*)
+ (:? "\\?" eglot--glob-emit-?)
+ (:{} "{[^][*{}]+}" eglot--glob-emit-{})
+ (:range "\\[\\^?[^][/,*{}]+\\]" eglot--glob-emit-range)
+ (:literal "[^][,*?{}]+" eglot--glob-emit-self))
+ until (eobp)
+ collect (cl-loop
+ for (_token regexp emitter) in grammar
+ thereis (and (re-search-forward (concat "\\=" regexp) nil t)
+ (list (cl-gensym "state-") emitter (match-string
0)))
+ finally (error "Glob '%s' invalid at %s" (buffer-string)
(point))))))
+
+(defun eglot--glob-compile (glob &optional byte-compile noerror)
+ "Convert GLOB into Elisp function. Maybe BYTE-COMPILE it.
+If NOERROR, return predicate, else erroring function."
+ (let* ((states (eglot--glob-parse glob))
+ (body `(with-current-buffer (get-buffer-create "
*eglot-glob-matcher*")
+ (erase-buffer)
+ (save-excursion (insert string))
+ (cl-labels ,(cl-loop for (this that) on states
+ for (self emit text) = this
+ for next = (or (car that) 'eobp)
+ collect (funcall emit text self next))
+ (or (,(caar states))
+ (error "Glob done but more unmatched text: '%s'"
+ (buffer-substring (point) (point-max)))))))
+ (form `(lambda (string) ,(if noerror `(ignore-errors ,body) body))))
+ (if byte-compile (byte-compile form) form)))
+
+(defun eglot--glob-emit-self (text self next)
+ `(,self () (re-search-forward ,(concat "\\=" (regexp-quote text))) (,next)))
+
+(defun eglot--glob-emit-** (_ self next)
+ `(,self () (or (ignore-errors (save-excursion (,next)))
+ (and (re-search-forward "\\=/?[^/]+/?") (,self)))))
+
+(defun eglot--glob-emit-* (_ self next)
+ `(,self () (re-search-forward "\\=[^/]")
+ (or (ignore-errors (save-excursion (,next))) (,self))))
+
+(defun eglot--glob-emit-? (_ self next)
+ `(,self () (re-search-forward "\\=[^/]") (,next)))
+
+(defun eglot--glob-emit-{} (arg self next)
+ (let ((alternatives (split-string (substring arg 1 (1- (length arg))) ",")))
+ `(,self ()
+ (or (re-search-forward ,(concat "\\=" (regexp-opt alternatives))
nil t)
+ (error "Failed matching any of %s" ',alternatives))
+ (,next))))
+
+(defun eglot--glob-emit-range (arg self next)
+ (when (eq ?! (aref arg 1)) (aset arg 1 ?^))
+ `(,self () (re-search-forward ,(concat "\\=" arg)) (,next)))
+
+
+;;; List connections mode
+
+(define-derived-mode eglot-list-connections-mode tabulated-list-mode
+ "" "Eglot mode for listing server connections
+\\{eglot-list-connections-mode-map}"
+ (setq-local tabulated-list-format
+ `[("Language server" 16) ("Project name" 16) ("Modes handled"
16)])
+ (tabulated-list-init-header))
+
+(defun eglot-list-connections ()
+ "List currently active Eglot connections."
+ (interactive)
+ (with-current-buffer
+ (get-buffer-create "*EGLOT connections*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (eglot-list-connections-mode)
+ (setq-local tabulated-list-entries
+ (mapcar
+ (lambda (server)
+ (list server
+ `[,(or (plist-get (eglot--server-info server) :name)
+ (jsonrpc-name server))
+ ,(eglot-project-nickname server)
+ ,(mapconcat #'symbol-name
+ (eglot--major-modes server)
+ ", ")]))
+ (cl-reduce #'append
+ (hash-table-values eglot--servers-by-project))))
+ (revert-buffer)
+ (pop-to-buffer (current-buffer)))))
+
+
+;;; Hacks
+;;;
+;; FIXME: Although desktop.el compatibility is Emacs bug#56407, the
+;; optimal solution agreed to there is a bit more work than what I
+;; have time to right now. See
+;; e.g. https://debbugs.gnu.org/cgi/bugreport.cgi?bug=bug%2356407#68.
+;; For now, just use `with-eval-after-load'
+(with-eval-after-load 'desktop
+ (add-to-list 'desktop-minor-mode-handlers '(eglot--managed-mode . ignore)))
+
+
+;;; Obsolete
+;;;
+
+(make-obsolete-variable 'eglot--managed-mode-hook
+ 'eglot-managed-mode-hook "1.6")
+(provide 'eglot)
+
+
+;;; Backend completion
+
+;; Written by Stefan Monnier circa 2016. Something to move to
+;; minibuffer.el "ASAP" (with all the `eglot--lsp-' replaced by
+;; something else. The very same code already in SLY and stable for a
+;; long time.
+
+;; This "completion style" delegates all the work to the "programmable
+;; completion" table which is then free to implement its own
+;; completion style. Typically this is used to take advantage of some
+;; external tool which already has its own completion system and
+;; doesn't give you efficient access to the prefix completion needed
+;; by other completion styles. The table should recognize the symbols
+;; 'eglot--lsp-tryc and 'eglot--lsp-allc as ACTION, reply with
+;; (eglot--lsp-tryc COMP...) or (eglot--lsp-allc . (STRING . POINT)),
+;; accordingly. tryc/allc names made akward/recognizable on purpose.
+
+(add-to-list 'completion-styles-alist
+ '(eglot--lsp-backend-style
+ eglot--lsp-backend-style-try-completion
+ eglot--lsp-backend-style-all-completions
+ "Ad-hoc completion style provided by the completion table."))
+
+(defun eglot--lsp-backend-style-call (op string table pred point)
+ (when (functionp table)
+ (let ((res (funcall table string pred (cons op point))))
+ (when (eq op (car-safe res))
+ (cdr res)))))
+
+(defun eglot--lsp-backend-style-try-completion (string table pred point)
+ (eglot--lsp-backend-style-call 'eglot--lsp-tryc string table pred point))
+
+(defun eglot--lsp-backend-style-all-completions (string table pred point)
+ (eglot--lsp-backend-style-call 'eglot--lsp-allc string table pred point))
+
+
+;; Local Variables:
+;; bug-reference-bug-regexp: "\\(github#\\([0-9]+\\)\\)"
+;; bug-reference-url-format: "https://github.com/joaotavora/eglot/issues/%s";
+;; checkdoc-force-docstrings-flag: nil
+;; End:
+
+;;; eglot.el ends here
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 7e7ea6aeb9..7c470de195 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -52,7 +52,7 @@ All commands in `lisp-mode-shared-map' are inherited by this
map."
:parent lisp-mode-shared-map
"M-TAB" #'completion-at-point
"C-M-x" #'eval-defun
- "C-c C-e" #'elisp-eval-buffer
+ "C-c C-e" #'elisp-eval-region-or-buffer
"C-c C-f" #'elisp-byte-compile-file
"C-c C-b" #'elisp-byte-compile-buffer
"C-M-q" #'indent-pp-sexp)
@@ -280,7 +280,9 @@ Comments in the form will be lost."
(remove-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs))
(defun elisp-enable-lexical-binding (&optional interactive)
- "Make the current buffer use `lexical-binding'."
+ "Make the current buffer use `lexical-binding'.
+INTERACTIVE non-nil means ask the user for confirmation; this
+happens in interactive invocations."
(interactive "p")
(if lexical-binding
(when interactive
@@ -360,7 +362,7 @@ be used instead.
;;; Completion at point for Elisp
(defun elisp--local-variables-1 (vars sexp)
- "Return the vars locally bound around the witness, or nil if not found."
+ "Return VARS locally bound around the witness, or nil if not found."
(let (res)
(while
(unless
@@ -463,7 +465,7 @@ be used instead.
lastvars)))))
(defun elisp--expect-function-p (pos)
- "Return non-nil if the symbol at point is expected to be a function."
+ "Return non-nil if the symbol at position POS is expected to be a function."
(or
(and (eq (char-before pos) ?')
(eq (char-before (1- pos)) ?#))
@@ -1232,7 +1234,7 @@ All commands in `lisp-mode-shared-map' are inherited by
this map."
:parent lisp-mode-shared-map
"C-M-x" #'eval-defun
"C-M-q" #'indent-pp-sexp
- "C-c C-e" #'elisp-eval-buffer
+ "C-c C-e" #'elisp-eval-region-or-buffer
"C-c C-b" #'elisp-byte-compile-buffer
"M-TAB" #'completion-at-point
"C-j" #'eval-print-last-sexp)
@@ -1331,12 +1333,12 @@ Semicolons start comments.
(defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal)
"Evaluate sexp before point; print value into current buffer.
+Interactively, EVAL-LAST-SEXP-ARG-INTERNAL is the prefix numeric argument.
Normally, this function truncates long output according to the value
of the variables `eval-expression-print-length' and
-`eval-expression-print-level'. With a prefix argument of zero,
-however, there is no such truncation. Such a prefix argument
-also causes integers to be printed in several additional formats
-\(octal, hexadecimal, and character).
+`eval-expression-print-level'. But if EVAL-LAST-SEXP-ARG-INTERNAL is zero,
+there is no such truncation, and integers are printed in several additional
+formats (octal, hexadecimal, and character).
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger."
@@ -1557,8 +1559,8 @@ POS specifies the starting position where EXP was found
and defaults to point."
(defun eval-last-sexp (eval-last-sexp-arg-internal)
"Evaluate sexp before point; print value in the echo area.
-Interactively, with a non `-' prefix argument, print output into
-current buffer.
+Interactively, EVAL-LAST-SEXP-ARG-INTERNAL is the prefix argument.
+With a non `-' prefix argument, print output into current buffer.
This commands handles `defvar', `defcustom' and `defface' the
same way that `eval-defun' does. See the doc string of that
@@ -1588,7 +1590,7 @@ this command arranges for all errors to enter the
debugger."
(car value))))
(defun elisp--eval-defun-1 (form)
- "Treat some expressions specially.
+ "Treat some expressions in FORM specially.
Reset the `defvar' and `defcustom' variables to the initial value.
\(For `defcustom', use the :set function if there is one.)
Reinitialize the face according to the `defface' specification."
@@ -1688,15 +1690,21 @@ Return the result of evaluation."
elisp--eval-defun-result))
(defun eval-defun (edebug-it)
- "Evaluate the top-level form containing point.
+ "Evaluate top-level form around point and instrument it if EDEBUG-IT is
non-nil.
+Interactively, EDEBUG-IT is the prefix argument.
+If `edebug-all-defs' is non-nil, that inverts the meaning of EDEBUG-IT
+and the prefix argument: this function will instrument the form
+unless EDEBUG-IT is non-nil. The command `edebug-all-defs' toggles
+the value of the variable `edebug-all-defs'.
+
If point isn't in a top-level form, evaluate the first top-level
form after point. If there is no top-level form after point,
-eval the first preceeding top-level form.
+evaluate the first preceding top-level form.
If the current defun is actually a call to `defvar' or `defcustom',
evaluating it this way resets the variable using its initial value
expression (using the defcustom's :set function if there is one), even
-if the variable already has some other value. \(Normally `defvar' and
+if the variable already has some other value. (Normally `defvar' and
`defcustom' do not alter the value if there already is one.) In an
analogous way, evaluating a `defface' overrides any customizations of
the face, so that it becomes defined exactly as the `defface' expression
@@ -1705,8 +1713,6 @@ says.
If `eval-expression-debug-on-error' is non-nil, which is the default,
this command arranges for all errors to enter the debugger.
-With a prefix argument, instrument the code for Edebug.
-
If acting on a `defun' for FUNCTION, and the function was
instrumented, `Edebug: FUNCTION' is printed in the echo area. If not
instrumented, just FUNCTION is printed.
@@ -1734,7 +1740,8 @@ which see."
;;; ElDoc Support
(defvar elisp--eldoc-last-data (make-vector 3 nil)
- "Bookkeeping; elements are as follows:
+ "Bookkeeping.
+Elements are as follows:
0 - contains the last symbol read from the buffer.
1 - contains the string last displayed in the echo area for variables,
or argument string for functions.
@@ -1766,7 +1773,7 @@ it is preferable to use ElDoc's interfaces directly.")
"use ElDoc's interfaces instead." "28.1")
(defun elisp-eldoc-funcall (callback &rest _ignored)
- "Document function call at point.
+ "Document function call at point by calling CALLBACK.
Intended for `eldoc-documentation-functions' (which see)."
(let* ((sym-info (elisp--fnsym-in-current-sexp))
(fn-sym (car sym-info)))
@@ -1778,7 +1785,7 @@ Intended for `eldoc-documentation-functions' (which see)."
'font-lock-keyword-face)))))
(defun elisp-eldoc-var-docstring (callback &rest _ignored)
- "Document variable at point.
+ "Document variable at point by calling CALLBACK.
Intended for `eldoc-documentation-functions' (which see).
Also see `elisp-eldoc-var-docstring-with-value'."
(let* ((sym (elisp--current-symbol))
@@ -1789,7 +1796,7 @@ Also see `elisp-eldoc-var-docstring-with-value'."
:face 'font-lock-variable-name-face))))
(defun elisp-eldoc-var-docstring-with-value (callback &rest _)
- "Document variable at point.
+ "Document variable at point by calling CALLBACK.
Intended for `eldoc-documentation-functions' (which see).
Compared to `elisp-eldoc-var-docstring', this also includes the
current variable value and a bigger chunk of the docstring."
@@ -1817,6 +1824,7 @@ current variable value and a bigger chunk of the
docstring."
(defun elisp-get-fnsym-args-string (sym &optional index)
"Return a string containing the parameter list of the function SYM.
+INDEX is the index of the parameter in the returned string to highlight.
If SYM is a subr and no arglist is obtainable from the docstring
or elsewhere, return a 1-line docstring."
(let ((argstring
@@ -1826,8 +1834,8 @@ or elsewhere, return a 1-line docstring."
(eq 'function (aref elisp--eldoc-last-data 2)))
(aref elisp--eldoc-last-data 1))
(t
- (let* ((advertised (gethash (indirect-function sym)
- advertised-signature-table t))
+ (let* ((advertised (get-advertised-calling-convention
+ (indirect-function sym)))
doc
(args
(cond
@@ -1847,7 +1855,8 @@ or elsewhere, return a 1-line docstring."
sym argstring index))))
(defun elisp--highlight-function-argument (sym args index)
- "Highlight argument INDEX in ARGS list for function SYM."
+ "Highlight the argument of function SYM whose index is INDEX.
+ARGS is the argument list of function SYM."
;; FIXME: This should probably work on the list representation of `args'
;; rather than its string representation.
;; FIXME: This function is much too long, we need to split it up!
@@ -2203,11 +2212,17 @@ Runs in a batch-mode Emacs. Interactively use variable
(terpri)
(pp collected)))
-(defun elisp-eval-buffer ()
- "Evaluate the forms in the current buffer."
+(defun elisp-eval-region-or-buffer ()
+ "Evaluate the forms in the active region or the whole current buffer.
+In Transient Mark mode when the mark is active, call `eval-region'.
+Otherwise, call `eval-buffer'."
(interactive)
- (eval-buffer)
- (message "Evaluated the %s buffer" (buffer-name)))
+ (if (use-region-p)
+ (eval-region (region-beginning) (region-end))
+ (eval-buffer))
+ (message "Evaluated the %s%s buffer"
+ (if (use-region-p) "region in the " "")
+ (buffer-name)))
(defun elisp-byte-compile-file (&optional load)
"Byte compile the file the current buffer is visiting.
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index 85c5992998..cbdb0994cb 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -1,7 +1,6 @@
;;; etags.el --- etags facility for Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1986, 1988-1989, 1992-1996, 1998, 2000-2022 Free
-;; Software Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Maintainer: emacs-devel@gnu.org
@@ -2006,16 +2005,15 @@ see the doc of that variable if you want to add names
to the list."
(set-buffer-modified-p nil)
(select-tags-table-mode))
-(defvar select-tags-table-mode-map ; Doc string?
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map button-buffer-map)
- (define-key map "t" 'push-button)
- (define-key map " " 'next-line)
- (define-key map "\^?" 'previous-line)
- (define-key map "n" 'next-line)
- (define-key map "p" 'previous-line)
- (define-key map "q" 'select-tags-table-quit)
- map))
+(defvar-keymap select-tags-table-mode-map
+ :doc "Keymap for `select-tags-table-mode'."
+ :parent button-buffer-map
+ "t" #'push-button
+ "SPC" #'next-line
+ "DEL" #'previous-line
+ "n" #'next-line
+ "p" #'previous-line
+ "q" #'select-tags-table-quit)
(define-derived-mode select-tags-table-mode special-mode "Select Tags Table"
"Major mode for choosing a current tags table among those already loaded."
diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el
index 49e36f4280..b44e625565 100644
--- a/lisp/progmodes/flymake-cc.el
+++ b/lisp/progmodes/flymake-cc.el
@@ -114,7 +114,7 @@ process that is passed the current buffer's contents via
stdin.
REPORT-FN is Flymake's callback."
;; HACK: XXX: Assuming this backend function is run before it in
;; `flymake-diagnostic-functions', very hackingly convince the other
- ;; backend `flymake-proc-legacy-backend', which is on by default, to
+ ;; backend `flymake-proc-legacy-flymake', which is on by default, to
;; disable itself.
;;
(setq-local flymake-proc-allowed-file-name-masks nil)
diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el
index 5bbbfa822f..adb984c3e5 100644
--- a/lisp/progmodes/flymake.el
+++ b/lisp/progmodes/flymake.el
@@ -1133,7 +1133,7 @@ special *Flymake log* buffer." :group 'flymake :lighter
(add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t)
(add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t)
- ;; If Flymake happened to be already already ON, we must cleanup
+ ;; If Flymake happened to be already ON, we must cleanup
;; existing diagnostic overlays, lest we forget them by blindly
;; reinitializing `flymake--state' in the next line.
;; See https://github.com/joaotavora/eglot/issues/223.
@@ -1360,8 +1360,9 @@ default) no filter is applied."
flymake-mode-line-warning-counter
flymake-mode-line-note-counter "]")
"Mode-line construct for formatting Flymake diagnostic counters.
-This is a suitable place for placing the `flymake-error-counter',
-`flymake-warning-counter' and `flymake-note-counter' constructs.
+This is a suitable place for placing the `flymake-mode-line-error-counter',
+`flymake-mode-line-warning-counter' and `flymake-mode-line-note-counter'
+constructs.
Separating each of these with space is not necessary."
:type '(repeat (choice string symbol)))
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
index 58d7a2026e..9a68c0e6fd 100644
--- a/lisp/progmodes/fortran.el
+++ b/lisp/progmodes/fortran.el
@@ -1,7 +1,6 @@
;;; fortran.el --- Fortran mode for GNU Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1986, 1993-1995, 1997-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1986-2022 Free Software Foundation, Inc.
;; Author: Michael D. Prange <prange@erl.mit.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -624,34 +623,32 @@ Used in the Fortran entry in `hs-special-modes-alist'.")
st)
"Syntax table used to parse Fortran expressions for printing in GUD.")
-(defvar fortran-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map ";" 'fortran-abbrev-start)
- (define-key map "\C-c;" 'fortran-comment-region)
- ;; The default comment-dwim does at least as much as this.
-;;; (define-key map "\M-;" 'fortran-indent-comment)
- (define-key map "\M-\n" 'fortran-split-line)
- (define-key map "\M-\C-n" 'fortran-end-of-block)
- (define-key map "\M-\C-p" 'fortran-beginning-of-block)
- (define-key map "\M-\C-q" 'fortran-indent-subprogram)
- (define-key map "\C-c\C-w" 'fortran-window-create-momentarily)
- (define-key map "\C-c\C-r" 'fortran-column-ruler)
- (define-key map "\C-c\C-p" 'fortran-previous-statement)
- (define-key map "\C-c\C-n" 'fortran-next-statement)
- (define-key map "\C-c\C-d" 'fortran-join-line) ; like f90
- (define-key map "\M-^" 'fortran-join-line) ; subvert delete-indentation
- (define-key map "0" 'fortran-electric-line-number)
- (define-key map "1" 'fortran-electric-line-number)
- (define-key map "2" 'fortran-electric-line-number)
- (define-key map "3" 'fortran-electric-line-number)
- (define-key map "4" 'fortran-electric-line-number)
- (define-key map "5" 'fortran-electric-line-number)
- (define-key map "6" 'fortran-electric-line-number)
- (define-key map "7" 'fortran-electric-line-number)
- (define-key map "8" 'fortran-electric-line-number)
- (define-key map "9" 'fortran-electric-line-number)
- map)
- "Keymap used in Fortran mode.")
+(defvar-keymap fortran-mode-map
+ :doc "Keymap used in Fortran mode."
+ ";" #'fortran-abbrev-start
+ "C-c ;" #'fortran-comment-region
+ ;; The default comment-dwim does at least as much as this.
+ ;; "M-;" #'fortran-indent-comment
+ "C-M-j" #'fortran-split-line
+ "C-M-n" #'fortran-end-of-block
+ "C-M-p" #'fortran-beginning-of-block
+ "C-M-q" #'fortran-indent-subprogram
+ "C-c C-w" #'fortran-window-create-momentarily
+ "C-c C-r" #'fortran-column-ruler
+ "C-c C-p" #'fortran-previous-statement
+ "C-c C-n" #'fortran-next-statement
+ "C-c C-d" #'fortran-join-line ; like f90
+ "M-^" #'fortran-join-line ; subvert delete-indentation
+ "0" #'fortran-electric-line-number
+ "1" #'fortran-electric-line-number
+ "2" #'fortran-electric-line-number
+ "3" #'fortran-electric-line-number
+ "4" #'fortran-electric-line-number
+ "5" #'fortran-electric-line-number
+ "6" #'fortran-electric-line-number
+ "7" #'fortran-electric-line-number
+ "8" #'fortran-electric-line-number
+ "9" #'fortran-electric-line-number)
(define-abbrev-table 'fortran-mode-abbrev-table
@@ -960,7 +957,7 @@ With non-nil ARG, uncomments the region."
(set-marker save-point nil)))
;; uncomment-region calls this with 3 args.
-(defun fortran-uncomment-region (start end &optional ignored)
+(defun fortran-uncomment-region (start end &optional _ignored)
"Uncomment every line in the region."
(fortran-comment-region start end t))
diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 6e8032b7ea..dff677e785 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -966,7 +966,7 @@ detailed description of this mode.
(if gdb-active-process
(gdb-gud-context-command "-exec-continue")
"-exec-run")))
- "C-v" "Start or continue execution. Use a prefix to specify arguments.")
+ "\C-v" "Start or continue execution. Use a prefix to specify arguments.")
;; For debugging Emacs only.
(gud-def gud-pp
@@ -4359,7 +4359,7 @@ member."
"Mapping of local variable names to a string with their value.")
(defun gdb-locals-values-handler-custom ()
- "Store the values of local variables in `gdb-locals-value-map'."
+ "Store the values of local variables in `gdb-locals-values-table'."
(let ((locals-list (bindat-get-field (gdb-mi--partial-output) 'variables)))
(dolist (local locals-list)
(let ((name (bindat-get-field local 'name))
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 281762fb0a..9b7d7a0535 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -752,7 +752,12 @@ It should return a list of completion strings.")
If COMMAND-LINE names a program FILE to debug, gdb will run in
a buffer named *gud-FILE*, and the directory containing FILE
becomes the initial working directory and source-file directory
-for your debugger.
+for your debugger. If you don't want `default-directory' to
+change to the directory of FILE, specify FILE without leading
+directories, in which case FILE should reside either in the
+directory of the buffer from which this command is invoked, or
+it can be found by searching PATH.
+
If COMMAND-LINE requests that gdb attaches to a process PID, gdb
will run in *gud-PID*, otherwise it will run in *gud*; in these
cases the initial working directory is the `default-directory' of
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
index 2a1b6d6b7b..655dd6a5d9 100644
--- a/lisp/progmodes/hideshow.el
+++ b/lisp/progmodes/hideshow.el
@@ -3,7 +3,7 @@
;; Copyright (C) 1994-2022 Free Software Foundation, Inc.
;; Author: Thien-Thi Nguyen <ttn@gnu.org>
-;; Dan Nicolaescu <dann@ics.uci.edu>
+;; Dan Nicolaescu <dann@gnu.org>
;; Keywords: C C++ java lisp tools editing comments blocks hiding outlines
;; Maintainer-Version: 5.65.2.2
;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
@@ -31,14 +31,14 @@
;; are available, implementing block hiding and showing. They (and their
;; keybindings) are:
;;
-;; hs-hide-block C-c @ C-h
-;; hs-show-block C-c @ C-s
-;; hs-hide-all C-c @ C-M-h
-;; hs-show-all C-c @ C-M-s
-;; hs-hide-level C-c @ C-l
-;; hs-toggle-hiding C-c @ C-c
-;; hs-toggle-hiding [(shift mouse-2)]
-;; hs-hide-initial-comment-block
+;; `hs-hide-block' C-c @ C-h
+;; `hs-show-block' C-c @ C-s
+;; `hs-hide-all' C-c @ C-M-h
+;; `hs-show-all' C-c @ C-M-s
+;; `hs-hide-level' C-c @ C-l
+;; `hs-toggle-hiding' C-c @ C-c
+;; `hs-toggle-hiding' S-<mouse-2>
+;; `hs-hide-initial-comment-block'
;;
;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they
;; are simply text between curly braces, while in Lisp-ish modes parens
@@ -50,16 +50,14 @@
;; * Suggested usage
;;
-;; First make sure hideshow.el is in a directory in your `load-path'.
-;; You can optionally byte-compile it using `M-x byte-compile-file'.
-;; Then, add the following to your init file:
+;; Add the following to your init file:
;;
-;; (load-library "hideshow")
-;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similarly
+;; (require 'hideshow)
+;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similarly
;;
;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle
;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is
-;; activated or deactivated, `hs-minor-mode-hook' is run w/ `run-hooks'.
+;; activated or deactivated, `hs-minor-mode-hook' is run with `run-hooks'.
;;
;; Additionally, Joseph Eydelnant writes:
;; I enjoy your package hideshow.el Version 5.24 2001/02/13
@@ -67,14 +65,14 @@
;; toggle hide/show all with a single key.
;; Here are a few lines of code that lets me do just that.
;;
-;; (defvar my-hs-hide nil "Current state of hideshow for toggling all.")
-;; ;;;###autoload
-;; (defun my-toggle-hideshow-all () "Toggle hideshow all."
-;; (interactive)
-;; (setq my-hs-hide (not my-hs-hide))
-;; (if my-hs-hide
-;; (hs-hide-all)
-;; (hs-show-all)))
+;; (defvar my-hs-hide nil "Current state of hideshow for toggling all.")
+;; ;;;###autoload
+;; (defun my-toggle-hideshow-all () "Toggle hideshow all."
+;; (interactive)
+;; (setq my-hs-hide (not my-hs-hide))
+;; (if my-hs-hide
+;; (hs-hide-all)
+;; (hs-show-all)))
;;
;; [Your hideshow hacks here!]
@@ -82,12 +80,12 @@
;;
;; You can use `M-x customize-variable' on the following variables:
;;
-;; - hs-hide-comments-when-hiding-all -- self-explanatory!
-;; - hs-hide-all-non-comment-function -- if non-nil, when doing a
-;; `hs-hide-all', this function
-;; is called w/ no arguments
-;; - hs-isearch-open -- what kind of hidden blocks to
-;; open when doing isearch
+;; - `hs-hide-comments-when-hiding-all' -- self-explanatory!
+;; - `hs-hide-all-non-comment-function' -- if non-nil, when doing a
+;; `hs-hide-all', this function
+;; is called with no arguments
+;; - `hs-isearch-open' -- what kind of hidden blocks to
+;; open when doing isearch
;;
;; Some languages (e.g., Java) are deeply nested, so the normal behavior
;; of `hs-hide-all' (hiding all but top-level blocks) results in very
@@ -96,21 +94,21 @@
;; what is more useful. For example, the following code shows the next
;; nested level in addition to the top-level:
;;
-;; (defun ttn-hs-hide-level-1 ()
-;; (when (hs-looking-at-block-start-p)
-;; (hs-hide-level 1))
-;; (forward-sexp 1))
-;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1)
+;; (defun ttn-hs-hide-level-1 ()
+;; (when (hs-looking-at-block-start-p)
+;; (hs-hide-level 1))
+;; (forward-sexp 1))
+;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1)
;;
-;; Hideshow works w/ incremental search (isearch) by setting the variable
+;; Hideshow works with incremental search (isearch) by setting the variable
;; `hs-headline', which is the line of text at the beginning of a hidden
;; block that contains a match for the search. You can have this show up
;; in the mode line by modifying the variable `mode-line-format'. For
;; example, the following code prepends this info to the mode line:
;;
-;; (unless (memq 'hs-headline mode-line-format)
-;; (setq mode-line-format
-;; (append '("-" hs-headline) mode-line-format)))
+;; (unless (memq 'hs-headline mode-line-format)
+;; (setq mode-line-format
+;; (append '("-" hs-headline) mode-line-format)))
;;
;; See documentation for `mode-line-format' for more info.
;;
@@ -121,8 +119,8 @@
;;
;; One of `hs-hide-hook' or `hs-show-hook' is run for the toggling
;; commands when the result of the toggle is to hide or show blocks,
-;; respectively. All hooks are run w/ `run-hooks'. See docs for each
-;; variable or hook for more info.
+;; respectively. All hooks are run with `run-hooks'. See the
+;; documentation for each variable or hook for more information.
;;
;; Normally, hideshow tries to determine appropriate values for block
;; and comment definitions by examining the buffer's major mode. If
@@ -256,7 +254,7 @@ This has effect only if `search-invisible' is set to
`open'."
;;;###autoload
(defvar hs-special-modes-alist
- (mapcar 'purecopy
+ (mapcar #'purecopy
'((c-mode "{" "}" "/[*/]" nil nil)
(c++-mode "{" "}" "/[*/]" nil nil)
(bibtex-mode ("@\\S(*\\(\\s(\\)" 1))
@@ -278,7 +276,7 @@ START, END and COMMENT-START are regular expressions. A
block is
defined as text surrounded by START and END.
As a special case, START may be a list of the form (COMPLEX-START
-MDATA-SELECTOR), where COMPLEX-START is a regexp w/ multiple parts and
+MDATA-SELECTOR), where COMPLEX-START is a regexp with multiple parts and
MDATA-SELECTOR an integer that specifies which sub-match is the proper
place to adjust point, before calling `hs-forward-sexp-func'. Point
is adjusted to the beginning of the specified match. For example,
@@ -348,22 +346,20 @@ info node `(elisp)Overlays'."
"Non-nil if using hideshow mode as a minor mode of some other mode.
Use the command `hs-minor-mode' to toggle or set this variable.")
-(defvar hs-minor-mode-map
- (let ((map (make-sparse-keymap)))
- ;; These bindings roughly imitate those used by Outline mode.
- (define-key map "\C-c@\C-h" 'hs-hide-block)
- (define-key map "\C-c@\C-s" 'hs-show-block)
- (define-key map "\C-c@\C-\M-h" 'hs-hide-all)
- (define-key map "\C-c@\C-\M-s" 'hs-show-all)
- (define-key map "\C-c@\C-l" 'hs-hide-level)
- (define-key map "\C-c@\C-c" 'hs-toggle-hiding)
- (define-key map "\C-c@\C-a" 'hs-show-all)
- (define-key map "\C-c@\C-t" 'hs-hide-all)
- (define-key map "\C-c@\C-d" 'hs-hide-block)
- (define-key map "\C-c@\C-e" 'hs-toggle-hiding)
- (define-key map [(shift mouse-2)] 'hs-toggle-hiding)
- map)
- "Keymap for hideshow minor mode.")
+(defvar-keymap hs-minor-mode-map
+ :doc "Keymap for hideshow minor mode."
+ ;; These bindings roughly imitate those used by Outline mode.
+ "C-c @ C-h" #'hs-hide-block
+ "C-c @ C-s" #'hs-show-block
+ "C-c @ C-M-h" #'hs-hide-all
+ "C-c @ C-M-s" #'hs-show-all
+ "C-c @ C-l" #'hs-hide-level
+ "C-c @ C-c" #'hs-toggle-hiding
+ "C-c @ C-a" #'hs-show-all
+ "C-c @ C-t" #'hs-hide-all
+ "C-c @ C-d" #'hs-hide-block
+ "C-c @ C-e" #'hs-toggle-hiding
+ "S-<mouse-2>" #'hs-toggle-hiding)
(easy-menu-define hs-minor-mode-menu hs-minor-mode-map
"Menu used when hideshow minor mode is active."
@@ -580,7 +576,7 @@ property of an overlay."
(save-match-data (not (nth 8 (syntax-ppss))))))
(defun hs-forward-sexp (match-data arg)
- "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG.
+ "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' with ARG.
Original match data is restored upon return."
(save-match-data
(set-match-data match-data)
@@ -778,12 +774,10 @@ region (point MAXP)."
(defmacro hs-life-goes-on (&rest body)
"Evaluate BODY forms if variable `hs-minor-mode' is non-nil.
-In the dynamic context of this macro, `inhibit-point-motion-hooks'
-and `case-fold-search' are both t."
+In the dynamic context of this macro, `case-fold-search' is t."
(declare (debug t))
`(when hs-minor-mode
- (let ((inhibit-point-motion-hooks t)
- (case-fold-search t))
+ (let ((case-fold-search t))
,@body)))
(defun hs-find-block-beginning-match ()
diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el
index 63f032b7b3..20472a6034 100644
--- a/lisp/progmodes/idlw-shell.el
+++ b/lisp/progmodes/idlw-shell.el
@@ -448,7 +448,7 @@ a face highlighting may be better."
We use a single character by default, since the main block of IDL procedures
often has no indentation. Where possible, IDLWAVE will use overlays to
display the stop-lines. The arrow is only used on character-based terminals.
-See also `idlwave-shell-use-overlay-arrow'."
+See also `idlwave-shell-mark-stop-line'."
:group 'idlwave-shell-highlighting-and-faces
:type 'string)
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
index cbbcf1c2b7..4cee361df3 100644
--- a/lisp/progmodes/make-mode.el
+++ b/lisp/progmodes/make-mode.el
@@ -1,6 +1,6 @@
;;; make-mode.el --- makefile editing commands for Emacs -*- lexical-binding:t
-*-
-;; Copyright (C) 1992, 1994, 1999-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1992-2022 Free Software Foundation, Inc.
;; Author: Thomas Neumann <tom@smart.bo.open.de>
;; Eric S. Raymond <esr@snark.thyrsus.com>
@@ -37,7 +37,7 @@
;;
;; The command C-c C-f adds certain filenames in the current directory
;; as targets. You can filter out filenames by setting the variable
-;; makefile-ignored-files-in-pickup-regex.
+;; `makefile-ignored-files-in-pickup-regex'.
;;
;; The command C-c C-u grinds for a bit, then pops up a report buffer
;; showing which target names are up-to-date with respect to their
@@ -49,11 +49,14 @@
;; all marked items back in the Makefile with C-c TAB.
;;
;; The command C-c TAB in the makefile buffer inserts a GNU make builtin.
-;; You will be prompted for the builtin's args.
+;; You will be prompted for the builtin's arguments.
;;
;; There are numerous other customization variables.
-;;
+
+
+;;; Code:
+
;; To Do:
;;
;; * Add missing doc strings, improve terse doc strings.
@@ -65,7 +68,7 @@
;; indentation and slashification done automatically. Hard.
;; * Consider removing browser mode. It seems useless.
;; * ":" should notice when a new target is made and add it to the
-;; list (or at least set makefile-need-target-pickup).
+;; list (or at least set `makefile-need-target-pickup').
;; * Make browser into a major mode.
;; * Clean up macro insertion stuff. It is a mess.
;; * Browser entry and exit is weird. Normalize.
@@ -78,15 +81,7 @@
;; * Update texinfo manual.
;; * Update files.el.
-
-
-;;; Code:
-
-;; Sadly we need this for a macro.
-(eval-when-compile
- (require 'imenu)
- (require 'dabbrev)
- (require 'add-log))
+(require 'subr-x) ; `string-limit'
;;; ------------------------------------------------------------
;;; Configurable stuff
@@ -488,17 +483,12 @@ not be enclosed in { } or ( )."
(defconst makefile-imake-font-lock-keywords
- (append
- (makefile-make-font-lock-keywords
- makefile-var-use-regex
- makefile-statements
- t
- nil
- '("^XCOMM.*$" . font-lock-comment-face)
- '("XVAR\\(?:use\\|def\\)[0-9]" 0 font-lock-keyword-face prepend)
- '("@@" . font-lock-preprocessor-face)
- )
- cpp-font-lock-keywords))
+ (append (list '("XCOMM.*$" . font-lock-comment-face)
+ '("XVAR\\(?:use\\|def\\)[0-9]" 0
+ font-lock-keyword-face prepend)
+ '("@@" . font-lock-preprocessor-face))
+ cpp-font-lock-keywords
+ makefile-font-lock-keywords))
(defconst makefile-syntax-propertize-function
@@ -546,7 +536,7 @@ This should identify a `make' command that can handle the
`-q' option."
'makefile-query-one-target-method-function "29.1")
(defcustom makefile-query-one-target-method-function
- 'makefile-query-by-make-minus-q
+ #'makefile-query-by-make-minus-q
"Function to call to determine whether a make target is up to date.
The function must satisfy this calling convention:
@@ -571,34 +561,31 @@ The function must satisfy this calling convention:
(define-abbrev-table 'makefile-mode-abbrev-table ()
"Abbrev table in use in Makefile buffers.")
-(defvar makefile-mode-map
- (let ((map (make-sparse-keymap)))
- ;; set up the keymap
- (define-key map "\C-c:" 'makefile-insert-target-ref)
- (if makefile-electric-keys
- (progn
- (define-key map "$" 'makefile-insert-macro-ref)
- (define-key map ":" 'makefile-electric-colon)
- (define-key map "=" 'makefile-electric-equal)
- (define-key map "." 'makefile-electric-dot)))
- (define-key map "\C-c\C-f" 'makefile-pickup-filenames-as-targets)
- (define-key map "\C-c\C-b" 'makefile-switch-to-browser)
- (define-key map "\C-c\C-c" 'comment-region)
- (define-key map "\C-c\C-p" 'makefile-pickup-everything)
- (define-key map "\C-c\C-u" 'makefile-create-up-to-date-overview)
- (define-key map "\C-c\C-i" 'makefile-insert-gmake-function)
- (define-key map "\C-c\C-\\" 'makefile-backslash-region)
- (define-key map "\C-c\C-m\C-a" 'makefile-automake-mode)
- (define-key map "\C-c\C-m\C-b" 'makefile-bsdmake-mode)
- (define-key map "\C-c\C-m\C-g" 'makefile-gmake-mode)
- (define-key map "\C-c\C-m\C-i" 'makefile-imake-mode)
- (define-key map "\C-c\C-m\C-m" 'makefile-mode)
- (define-key map "\C-c\C-m\C-p" 'makefile-makepp-mode)
- (define-key map "\M-p" 'makefile-previous-dependency)
- (define-key map "\M-n" 'makefile-next-dependency)
- (define-key map "\e\t" 'completion-at-point)
- map)
- "The keymap that is used in Makefile mode.")
+(defvar-keymap makefile-mode-map
+ :doc "The keymap that is used in Makefile mode."
+ "C-c :" #'makefile-insert-target-ref
+ "C-c C-f" #'makefile-pickup-filenames-as-targets
+ "C-c C-b" #'makefile-switch-to-browser
+ "C-c C-c" #'comment-region
+ "C-c C-p" #'makefile-pickup-everything
+ "C-c C-u" #'makefile-create-up-to-date-overview
+ "C-c TAB" #'makefile-insert-gmake-function
+ "C-c C-\\" #'makefile-backslash-region
+ "C-c RET C-a" #'makefile-automake-mode
+ "C-c RET C-b" #'makefile-bsdmake-mode
+ "C-c RET C-g" #'makefile-gmake-mode
+ "C-c RET TAB" #'makefile-imake-mode
+ "C-c RET RET" #'makefile-mode
+ "C-c RET C-p" #'makefile-makepp-mode
+ "M-p" #'makefile-previous-dependency
+ "M-n" #'makefile-next-dependency
+ "C-M-i" #'completion-at-point)
+
+(when makefile-electric-keys
+ (define-key makefile-mode-map "$" #'makefile-insert-macro-ref)
+ (define-key makefile-mode-map ":" #'makefile-electric-colon)
+ (define-key makefile-mode-map "=" #'makefile-electric-equal)
+ (define-key makefile-mode-map "." #'makefile-electric-dot))
(easy-menu-define makefile-mode-menu makefile-mode-map
"Menu for Makefile mode."
@@ -654,22 +641,20 @@ The function must satisfy this calling convention:
:selected (eq major-mode 'makefile-makepp-mode)])))
-(defvar makefile-browser-map
- (let ((map (make-sparse-keymap)))
- (define-key map "n" 'makefile-browser-next-line)
- (define-key map "\C-n" 'makefile-browser-next-line)
- (define-key map "p" 'makefile-browser-previous-line)
- (define-key map "\C-p" 'makefile-browser-previous-line)
- (define-key map " " 'makefile-browser-toggle)
- (define-key map "i" 'makefile-browser-insert-selection)
- (define-key map "I" 'makefile-browser-insert-selection-and-quit)
- (define-key map "\C-c\C-m" 'makefile-browser-insert-continuation)
- (define-key map "q" 'makefile-browser-quit)
- ;; disable horizontal movement
- (define-key map "\C-b" 'undefined)
- (define-key map "\C-f" 'undefined)
- map)
- "The keymap that is used in the macro- and target browser.")
+(defvar-keymap makefile-browser-map
+ :doc "The keymap that is used in the macro- and target browser."
+ "n" #'makefile-browser-next-line
+ "C-n" #'makefile-browser-next-line
+ "p" #'makefile-browser-previous-line
+ "C-p" #'makefile-browser-previous-line
+ "SPC" #'makefile-browser-toggle
+ "i" #'makefile-browser-insert-selection
+ "I" #'makefile-browser-insert-selection-and-quit
+ "C-c RET" #'makefile-browser-insert-continuation
+ "q" #'makefile-browser-quit
+ ;; disable horizontal movement
+ "C-b" #'undefined
+ "C-f" #'undefined)
(defvar makefile-mode-syntax-table
@@ -932,7 +917,9 @@ Makefile mode can be configured by modifying the following
variables:
:syntax-table makefile-imake-mode-syntax-table
(setq-local syntax-propertize-function nil)
(setq font-lock-defaults
- `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))))
+ `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults)))
+ (setq-local comment-start "XCOMM")
+ (setq-local comment-start-skip "XCOMM[ \t]*"))
@@ -1004,15 +991,15 @@ Anywhere else just self-inserts."
(self-insert-command arg)))
(defun makefile-insert-macro (macro-name)
- "Prepare definition of a new macro."
+ "Prepare definition of a new macro named MACRO-NAME.
+Interactively, prompt for the name of the macro."
(interactive "sMacro Name: ")
(makefile-pickup-macros)
- (if (not (zerop (length macro-name)))
- (progn
- (beginning-of-line)
- (insert macro-name makefile-macro-assign)
- (setq makefile-need-macro-pickup t)
- (makefile-remember-macro macro-name))))
+ (unless (zerop (length macro-name))
+ (beginning-of-line)
+ (insert macro-name makefile-macro-assign)
+ (setq makefile-need-macro-pickup t)
+ (makefile-remember-macro macro-name)))
(defun makefile-insert-macro-ref (macro-name)
"Complete on a list of known macros, then insert complete ref at point."
@@ -1026,24 +1013,23 @@ Anywhere else just self-inserts."
(defun makefile-insert-target (target-name)
"Prepare definition of a new target (dependency line)."
(interactive "sTarget: ")
- (if (not (zerop (length target-name)))
- (progn
- (beginning-of-line)
- (insert target-name makefile-target-colon)
- (makefile-forward-after-target-colon)
- (end-of-line)
- (setq makefile-need-target-pickup t)
- (makefile-remember-target target-name))))
+ (unless (zerop (length target-name))
+ (beginning-of-line)
+ (insert target-name makefile-target-colon)
+ (makefile-forward-after-target-colon)
+ (end-of-line)
+ (setq makefile-need-target-pickup t)
+ (makefile-remember-target target-name)))
(defun makefile-insert-target-ref (target-name)
"Complete on a list of known targets, then insert TARGET-NAME at point."
(interactive
(list
(progn
- (makefile-pickup-targets)
- (completing-read "Refer to target: " makefile-target-table nil nil nil))))
- (if (not (zerop (length target-name)))
- (insert target-name " ")))
+ (makefile-pickup-targets)
+ (completing-read "Refer to target: " makefile-target-table nil nil
nil))))
+ (unless (zerop (length target-name))
+ (insert target-name " ")))
(defun makefile-electric-colon (arg)
"Prompt for name of new target.
@@ -1084,7 +1070,7 @@ Anywhere else just self-inserts."
(skip-chars-forward " \t")
(not (or (eolp) (eq (char-after) ?:)))))
(forward-line)))
- (message "Read targets OK.")))
+ (message "Read targets OK")))
(defun makefile-pickup-macros ()
"Notice names of all macro definitions in Makefile."
@@ -1104,11 +1090,11 @@ Anywhere else just self-inserts."
(message "Picked up macro \"%s\" from line %d"
macro-name (line-number-at-pos))))
(forward-line)))
- (message "Read macros OK.")))
+ (message "Read macros OK")))
(defun makefile-pickup-everything (arg)
"Notice names of all macros and targets in Makefile.
-Prefix arg means force pickups to be redone."
+Prefix argument ARG means force pickups to be redone."
(interactive "P")
(if arg
(setq makefile-need-target-pickup t
@@ -1176,8 +1162,8 @@ and adds all qualifying names to the list of known
targets."
(defun makefile-backslash-region (from to delete-flag)
"Insert, align, or delete end-of-line backslashes on the lines in the region.
-With no argument, inserts backslashes and aligns existing backslashes.
-With an argument, deletes the backslashes.
+With no argument, insert backslashes and align existing backslashes.
+With an argument, delete the backslashes.
This function does not modify the last line of the region if the region ends
right at the start of the following line; it does not modify blank lines
@@ -1192,9 +1178,9 @@ definition and conveniently use this command."
(when (and makefile-backslash-align (not delete-flag))
(while (< (point) to)
(end-of-line)
- (if (= (preceding-char) ?\\)
- (progn (forward-char -1)
- (skip-chars-backward " \t")))
+ (when (= (preceding-char) ?\\)
+ (forward-char -1)
+ (skip-chars-backward " \t"))
(setq column (max column (1+ (current-column))))
(forward-line 1))
;; Adjust upward to a tab column, if that doesn't push
@@ -1361,18 +1347,16 @@ Fill comments, backslashed lines, and variable
definitions specially."
(defun makefile-browser-next-line ()
"Move the browser selection cursor to the next line."
(interactive)
- (if (not (makefile-last-line-p))
- (progn
- (forward-line 1)
- (forward-char makefile-browser-cursor-column))))
+ (unless (makefile-last-line-p)
+ (forward-line 1)
+ (forward-char makefile-browser-cursor-column)))
(defun makefile-browser-previous-line ()
"Move the browser selection cursor to the previous line."
(interactive)
- (if (not (makefile-first-line-p))
- (progn
- (forward-line -1)
- (forward-char makefile-browser-cursor-column))))
+ (unless (makefile-first-line-p)
+ (forward-line -1)
+ (forward-char makefile-browser-cursor-column)))
;;;
;;; Quitting the browser (returns to client buffer)
@@ -1472,14 +1456,17 @@ Insertion takes place at point."
(if (zerop (+ (length targets) (length macros)))
(progn
(beep)
- (message "No macros or targets to browse! Consider running
`makefile-pickup-everything'"))
+ (message
+ (substitute-command-keys
+ (concat "No macros or targets to browse! "
+ "Consider running \\[makefile-pickup-everything]"))))
(let ((browser-buffer (get-buffer-create makefile-browser-buffer-name)))
- (pop-to-buffer browser-buffer)
- (makefile-browser-fill targets macros)
- (shrink-window-if-larger-than-buffer)
- (setq-local makefile-browser-selection-vector
- (make-vector (+ (length targets) (length macros)) nil))
- (makefile-browser-start-interaction))))
+ (pop-to-buffer browser-buffer)
+ (makefile-browser-fill targets macros)
+ (shrink-window-if-larger-than-buffer)
+ (setq-local makefile-browser-selection-vector
+ (make-vector (+ (length targets) (length macros)) nil))
+ (makefile-browser-start-interaction))))
(defun makefile-switch-to-browser ()
(interactive)
@@ -1507,60 +1494,44 @@ dependency in the makefile."
;; writing the current contents of the makefile buffer.
;;
(let ((saved-target-table makefile-target-table)
- (this-buffer (current-buffer))
- (makefile-up-to-date-buffer
- (get-buffer-create makefile-up-to-date-buffer-name))
- (filename (makefile-save-temporary))
- ;;
- ;; Forget the target table because it may contain picked-up
filenames
- ;; that are not really targets in the current makefile.
- ;; We don't want to query these, so get a new target-table with
just the
- ;; targets that can be found in the makefile buffer.
- ;; The 'old' target table will be restored later.
- ;;
- (real-targets (progn
- (makefile-pickup-targets)
- makefile-target-table))
- (prereqs makefile-has-prereqs)
- )
-
- (set-buffer makefile-up-to-date-buffer)
- (setq buffer-read-only nil)
- (erase-buffer)
- (makefile-query-targets filename real-targets prereqs)
- (if (zerop (buffer-size)) ; if it did not get us anything
- (progn
- (kill-buffer (current-buffer))
- (message "No overview created!")))
- (set-buffer this-buffer)
- (setq makefile-target-table saved-target-table)
- (if (get-buffer makefile-up-to-date-buffer-name)
- (progn
- (pop-to-buffer (get-buffer makefile-up-to-date-buffer-name))
- (shrink-window-if-larger-than-buffer)
- (sort-lines nil (point-min) (point-max))
- (setq buffer-read-only t))))))
+ (this-buffer (current-buffer))
+ (makefile-up-to-date-buffer
+ (get-buffer-create makefile-up-to-date-buffer-name))
+ (filename (makefile-save-temporary))
+ ;;
+ ;; Forget the target table because it may contain picked-up
filenames
+ ;; that are not really targets in the current makefile.
+ ;; We don't want to query these, so get a new target-table with
just the
+ ;; targets that can be found in the makefile buffer.
+ ;; The 'old' target table will be restored later.
+ ;;
+ (real-targets (progn
+ (makefile-pickup-targets)
+ makefile-target-table))
+ (prereqs makefile-has-prereqs))
+ (unwind-protect
+ (progn
+ (set-buffer makefile-up-to-date-buffer)
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (makefile-query-targets filename real-targets prereqs)
+ (when (zerop (buffer-size)) ; if it did not get us anything
+ (kill-buffer (current-buffer))
+ (message "No overview created!"))
+ (set-buffer this-buffer)
+ (setq makefile-target-table saved-target-table)
+ (when (get-buffer makefile-up-to-date-buffer-name)
+ (pop-to-buffer (get-buffer makefile-up-to-date-buffer-name))
+ (shrink-window-if-larger-than-buffer)
+ (sort-lines nil (point-min) (point-max))
+ (setq buffer-read-only t)))
+ (ignore-errors (delete-file filename))))))
(defun makefile-save-temporary ()
"Create a temporary file from the current makefile buffer."
- (let ((filename (makefile-generate-temporary-filename)))
+ (let ((filename (make-temp-name "mktmp.")))
(write-region (point-min) (point-max) filename nil 0)
- filename)) ; return the filename
-
-(defun makefile-generate-temporary-filename ()
- "Create a filename suitable for use in `makefile-save-temporary'.
-Be careful to allow brain-dead file systems (DOS, SYSV ...) to cope
-with the generated name!"
- (let ((my-name (user-login-name))
- (my-uid (int-to-string (user-uid))))
- (concat "mktmp"
- (if (> (length my-name) 3)
- (substring my-name 0 3)
- my-name)
- "."
- (if (> (length my-uid) 3)
- (substring my-uid 0 3)
- my-uid))))
+ filename))
(defun makefile-query-targets (filename target-table prereq-list)
"Fill the up-to-date overview buffer.
@@ -1731,14 +1702,13 @@ matched in a rule action."
(defun makefile-remember-target (target-name &optional has-prereqs)
"Remember a given target if it is not already remembered for this buffer."
- (if (not (zerop (length target-name)))
- (progn
- (if (not (assoc target-name makefile-target-table))
- (setq makefile-target-table
- (cons (list target-name) makefile-target-table)))
- (if has-prereqs
- (setq makefile-has-prereqs
- (cons target-name makefile-has-prereqs))))))
+ (unless (zerop (length target-name))
+ (if (not (assoc target-name makefile-target-table))
+ (setq makefile-target-table
+ (cons (list target-name) makefile-target-table)))
+ (if has-prereqs
+ (setq makefile-has-prereqs
+ (cons target-name makefile-has-prereqs)))))
(defun makefile-remember-macro (macro-name)
"Remember a given macro if it is not already remembered for this buffer."
@@ -1827,6 +1797,13 @@ If it isn't in one, return nil."
(setq found (replace-regexp-in-string "\\`[ \t]+" "" found)))
found)))
+(defun makefile-generate-temporary-filename ()
+ "Create a filename suitable for use in `makefile-save-temporary'."
+ (declare (obsolete make-temp-name "29.1"))
+ (format "mktmp%s.%s"
+ (string-limit (user-login-name) 3)
+ (string-limit (int-to-string (user-uid)) 3)))
+
(provide 'make-mode)
;;; make-mode.el ends here
diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el
index 9d1ceaa55a..358b347f6e 100644
--- a/lisp/progmodes/mixal-mode.el
+++ b/lisp/progmodes/mixal-mode.el
@@ -33,9 +33,6 @@
;; GNU MDK from `https://savannah.gnu.org/projects/mdk/' and
;; `https://ftp.gnu.org/pub/gnu/mdk'.
;;
-;; To use this mode, place the following in your init file:
-;; `(load-file "/PATH-TO-FILE/mixal-mode.el")'.
-;;
;; When you load a file with the extension .mixal the mode will be started
;; automatically. If you want to start the mode manually, use `M-x
mixal-mode'.
;; Font locking will work, the behavior of tabs is the same as Emacs's
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
index e668570ba1..09cb848fd5 100644
--- a/lisp/progmodes/modula2.el
+++ b/lisp/progmodes/modula2.el
@@ -65,39 +65,36 @@
"Column for aligning the end of a comment, in Modula-2."
:type 'integer)
-;;; Added by TEP
-(defvar m2-mode-map
- (let ((map (make-sparse-keymap)))
- ;; FIXME: Many of those bindings are contrary to coding conventions.
- (define-key map "\C-cb" #'m2-begin)
- (define-key map "\C-cc" #'m2-case)
- (define-key map "\C-cd" #'m2-definition)
- (define-key map "\C-ce" #'m2-else)
- (define-key map "\C-cf" #'m2-for)
- (define-key map "\C-ch" #'m2-header)
- (define-key map "\C-ci" #'m2-if)
- (define-key map "\C-cm" #'m2-module)
- (define-key map "\C-cl" #'m2-loop)
- (define-key map "\C-co" #'m2-or)
- (define-key map "\C-cp" #'m2-procedure)
- (define-key map "\C-c\C-w" #'m2-with)
- (define-key map "\C-cr" #'m2-record)
- (define-key map "\C-cs" #'m2-stdio)
- (define-key map "\C-ct" #'m2-type)
- (define-key map "\C-cu" #'m2-until)
- (define-key map "\C-cv" #'m2-var)
- (define-key map "\C-cw" #'m2-while)
- (define-key map "\C-cx" #'m2-export)
- (define-key map "\C-cy" #'m2-import)
- (define-key map "\C-c{" #'m2-begin-comment)
- (define-key map "\C-c}" #'m2-end-comment)
- (define-key map "\C-c\C-z" #'suspend-emacs)
- (define-key map "\C-c\C-v" #'m2-visit)
- (define-key map "\C-c\C-t" #'m2-toggle)
- (define-key map "\C-c\C-l" #'m2-link)
- (define-key map "\C-c\C-c" #'m2-compile)
- map)
- "Keymap used in Modula-2 mode.")
+(defvar-keymap m2-mode-map
+ :doc "Keymap used in Modula-2 mode."
+ ;; FIXME: Many of those bindings are contrary to coding conventions.
+ "C-c b" #'m2-begin
+ "C-c c" #'m2-case
+ "C-c d" #'m2-definition
+ "C-c e" #'m2-else
+ "C-c f" #'m2-for
+ "C-c h" #'m2-header
+ "C-c i" #'m2-if
+ "C-c m" #'m2-module
+ "C-c l" #'m2-loop
+ "C-c o" #'m2-or
+ "C-c p" #'m2-procedure
+ "C-c C-w" #'m2-with
+ "C-c r" #'m2-record
+ "C-c s" #'m2-stdio
+ "C-c t" #'m2-type
+ "C-c u" #'m2-until
+ "C-c v" #'m2-var
+ "C-c w" #'m2-while
+ "C-c x" #'m2-export
+ "C-c y" #'m2-import
+ "C-c {" #'m2-begin-comment
+ "C-c }" #'m2-end-comment
+ "C-c C-z" #'suspend-emacs
+ "C-c C-v" #'m2-visit
+ "C-c C-t" #'m2-toggle
+ "C-c C-l" #'m2-link
+ "C-c C-c" #'m2-compile)
(defcustom m2-indent 5
"This variable gives the indentation in Modula-2 mode."
diff --git a/lisp/progmodes/octave.el b/lisp/progmodes/octave.el
index 18b9899169..bce5bc3ba7 100644
--- a/lisp/progmodes/octave.el
+++ b/lisp/progmodes/octave.el
@@ -1,6 +1,6 @@
;;; octave.el --- editing octave source files under emacs -*-
lexical-binding: t; -*-
-;; Copyright (C) 1997, 2001-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2022 Free Software Foundation, Inc.
;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at>
;; John Eaton <jwe@octave.org>
@@ -65,43 +65,39 @@ The string `function' and its name are given by the first
and third
parenthetical grouping.")
-(defvar octave-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\M-." 'octave-find-definition)
- (define-key map "\M-\C-j" 'octave-indent-new-comment-line)
- (define-key map "\C-c\C-p" 'octave-previous-code-line)
- (define-key map "\C-c\C-n" 'octave-next-code-line)
- (define-key map "\C-c\C-a" 'octave-beginning-of-line)
- (define-key map "\C-c\C-e" 'octave-end-of-line)
- (define-key map [remap down-list] 'smie-down-list)
- (define-key map "\C-c\M-\C-h" 'octave-mark-block)
- (define-key map "\C-c]" 'smie-close-block)
- (define-key map "\C-c/" 'smie-close-block)
- (define-key map "\C-c;" 'octave-update-function-file-comment)
- (define-key map "\C-hd" 'octave-help)
- (define-key map "\C-ha" 'octave-lookfor)
- (define-key map "\C-c\C-l" 'octave-source-file)
- (define-key map "\C-c\C-f" 'octave-insert-defun)
- (define-key map "\C-c\C-il" 'octave-send-line)
- (define-key map "\C-c\C-ib" 'octave-send-block)
- (define-key map "\C-c\C-if" 'octave-send-defun)
- (define-key map "\C-c\C-ir" 'octave-send-region)
- (define-key map "\C-c\C-ia" 'octave-send-buffer)
- (define-key map "\C-c\C-is" 'octave-show-process-buffer)
- (define-key map "\C-c\C-iq" 'octave-hide-process-buffer)
- (define-key map "\C-c\C-ik" 'octave-kill-process)
- (define-key map "\C-c\C-i\C-l" 'octave-send-line)
- (define-key map "\C-c\C-i\C-b" 'octave-send-block)
- (define-key map "\C-c\C-i\C-f" 'octave-send-defun)
- (define-key map "\C-c\C-i\C-r" 'octave-send-region)
- (define-key map "\C-c\C-i\C-a" 'octave-send-buffer)
- (define-key map "\C-c\C-i\C-s" 'octave-show-process-buffer)
- (define-key map "\C-c\C-i\C-q" 'octave-hide-process-buffer)
- (define-key map "\C-c\C-i\C-k" 'octave-kill-process)
- map)
- "Keymap used in Octave mode.")
-
-
+(defvar-keymap octave-mode-map
+ :doc "Keymap used in Octave mode."
+ "M-." #'octave-find-definition
+ "C-M-j" #'octave-indent-new-comment-line
+ "C-c C-p" #'octave-previous-code-line
+ "C-c C-n" #'octave-next-code-line
+ "C-c C-a" #'octave-beginning-of-line
+ "C-c C-e" #'octave-end-of-line
+ "<remap> <down-list>" #'smie-down-list
+ "C-c C-M-h" #'octave-mark-block
+ "C-c ]" #'smie-close-block
+ "C-c /" #'smie-close-block
+ "C-c ;" #'octave-update-function-file-comment
+ "C-h d" #'octave-help
+ "C-h a" #'octave-lookfor
+ "C-c C-l" #'octave-source-file
+ "C-c C-f" #'octave-insert-defun
+ "C-c C-i l" #'octave-send-line
+ "C-c C-i b" #'octave-send-block
+ "C-c C-i f" #'octave-send-defun
+ "C-c C-i r" #'octave-send-region
+ "C-c C-i a" #'octave-send-buffer
+ "C-c C-i s" #'octave-show-process-buffer
+ "C-c C-i q" #'octave-hide-process-buffer
+ "C-c C-i k" #'octave-kill-process
+ "C-c C-i C-l" #'octave-send-line
+ "C-c C-i C-b" #'octave-send-block
+ "C-c C-i C-f" #'octave-send-defun
+ "C-c C-i C-r" #'octave-send-region
+ "C-c C-i C-a" #'octave-send-buffer
+ "C-c C-i C-s" #'octave-show-process-buffer
+ "C-c C-i C-q" #'octave-hide-process-buffer
+ "C-c C-i C-k" #'octave-kill-process)
(easy-menu-define octave-mode-menu octave-mode-map
"Menu for Octave mode."
diff --git a/lisp/progmodes/opascal.el b/lisp/progmodes/opascal.el
index 5ed719b5a7..fb1e501066 100644
--- a/lisp/progmodes/opascal.el
+++ b/lisp/progmodes/opascal.el
@@ -275,8 +275,7 @@ nested routine.")
(declare (debug t))
`(save-excursion
(save-match-data
- (let ((inhibit-point-motion-hooks t)
- (deactivate-mark nil))
+ (let ((deactivate-mark nil))
(progn ,@forms)))))
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
index 7b7a2cdf01..4dd0fd67a6 100644
--- a/lisp/progmodes/perl-mode.el
+++ b/lisp/progmodes/perl-mode.el
@@ -27,8 +27,8 @@
;;; Commentary:
-;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
-;; to your init file and change the first line of your perl script to:
+;; To enter `perl-mode' automatically, change the first line of your
+;; perl script to:
;; #!/usr/bin/perl -- # -*-Perl-*-
;; With arguments to perl:
;; #!/usr/bin/perl -P- # -*-Perl-*-
@@ -215,11 +215,16 @@
(eval-and-compile
(defconst perl--syntax-exp-intro-keywords
'("split" "if" "unless" "until" "while" "print" "printf"
- "grep" "map" "not" "or" "and" "for" "foreach" "return"))
+ "grep" "map" "not" "or" "and" "for" "foreach" "return" "die"
+ "warn" "eval"))
(defconst perl--syntax-exp-intro-regexp
(concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)"
(regexp-opt perl--syntax-exp-intro-keywords)
+ ;; A HERE document as an argument to printf?
+ ;; when printing to a filehandle.
+ "\\|printf?[ \t]*\\$?[_[:alpha:]][_[:alnum:]]*"
+ "\\|=>"
"\\|[?:.,;|&*=!~({[]"
"\\|[^-+][-+]" ;Bug#42168: `+' is intro but `++' isn't!
"\\|\\(^\\)\\)[ \t\n]*")))
@@ -335,7 +340,7 @@
"<<\\(~\\)?[
\t]*\\('[^'\n]*'\\|\"[^\"\n]*\"\\|\\\\[[:alpha:]][[:alnum:]]*\\)"
;; The <<EOF case which needs perl--syntax-exp-intro-regexp, to
;; disambiguate with the left-bitshift operator.
- "\\|" perl--syntax-exp-intro-regexp "<<\\(?2:\\sw+\\)\\)"
+ "\\|" perl--syntax-exp-intro-regexp "<<\\(?1:~\\)?\\(?2:\\sw+\\)\\)"
".*\\(\n\\)")
(4 (let* ((eol (match-beginning 4))
(st (get-text-property eol 'syntax-table))
diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el
index f87230bd2f..58cb48f182 100644
--- a/lisp/progmodes/prog-mode.el
+++ b/lisp/progmodes/prog-mode.el
@@ -155,7 +155,7 @@ which case it will be used to compose the new symbol as per
the
third argument of `compose-region'.")
(defun prettify-symbols-default-compose-p (start end _match)
- "Return non-nil iff the symbol MATCH should be composed.
+ "Return non-nil if the symbol MATCH should be composed.
The symbol starts at position START and ends at position END.
This is the default for `prettify-symbols-compose-predicate'
which is suitable for most programming languages such as C or Lisp."
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index ee94d0d85d..63510e9050 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1,7 +1,7 @@
;;; project.el --- Operations on the current project -*- lexical-binding: t;
-*-
;; Copyright (C) 2015-2022 Free Software Foundation, Inc.
-;; Version: 0.8.1
+;; Version: 0.8.3
;; Package-Requires: ((emacs "26.1") (xref "1.4.0"))
;; This is a GNU ELPA :core package. Avoid using functionality that
@@ -296,7 +296,6 @@ to find the list of ignores for each directory."
(defun project--files-in-directory (dir ignores &optional files)
(require 'find-dired)
(require 'xref)
- (defvar find-name-arg)
(let* ((default-directory dir)
;; Make sure ~/ etc. in local directory name is
;; expanded and not left for the shell command
@@ -308,11 +307,11 @@ to find the list of ignores for each directory."
(xref--find-ignores-arguments ignores "./")
(if files
(concat (shell-quote-argument "(")
- " " find-name-arg " "
+ " -name "
(mapconcat
#'shell-quote-argument
(split-string files)
- (concat " -o " find-name-arg " "))
+ (concat " -o -name "))
" "
(shell-quote-argument ")"))
"")))
@@ -353,7 +352,10 @@ Also quote LOCAL-FILES if `default-directory' is quoted."
local-files))))
(cl-defgeneric project-buffers (project)
- "Return the list of all live buffers that belong to PROJECT."
+ "Return the list of all live buffers that belong to PROJECT.
+
+The default implementation matches each buffer to PROJECT root using
+the buffer's value of `default-directory'."
(let ((root (expand-file-name (file-name-as-directory (project-root
project))))
bufs)
(dolist (buf (buffer-list))
@@ -710,6 +712,7 @@ DIRS must contain directory names."
(define-key map "G" 'project-or-external-find-regexp)
(define-key map "r" 'project-query-replace-regexp)
(define-key map "x" 'project-execute-extended-command)
+ (define-key map "\C-b" 'project-list-buffers)
map)
"Keymap for project commands.")
@@ -1220,13 +1223,38 @@ displayed."
(interactive (list (project--read-project-buffer)))
(display-buffer-other-frame buffer-or-name))
+;;;###autoload
+(defun project-list-buffers (&optional arg)
+ "Display a list of project buffers.
+The list is displayed in a buffer named \"*Buffer List*\".
+
+By default, all project buffers are listed except those whose names
+start with a space (which are for internal use). With prefix argument
+ARG, show only buffers that are visiting files."
+ (interactive "P")
+ (let ((pr (project-current t)))
+ (display-buffer
+ (if (version< emacs-version "29.0.50")
+ (let ((buf (list-buffers-noselect arg (project-buffers pr))))
+ (with-current-buffer buf
+ (setq-local revert-buffer-function
+ (lambda (&rest _ignored)
+ (list-buffers--refresh (project-buffers pr))
+ (tabulated-list-print t))))
+ buf)
+ (list-buffers-noselect
+ arg nil (lambda (buf) (memq buf (project-buffers pr))))))))
+
(defcustom project-kill-buffer-conditions
'(buffer-file-name ; All file-visiting buffers are included.
- ;; Most of the temp buffers in the background:
- (major-mode . fundamental-mode)
+ ;; Most of temp and logging buffers (aside from hidden ones):
+ (and
+ (major-mode . fundamental-mode)
+ "\\`[^ ]")
;; non-text buffer such as xref, occur, vc, log, ...
(and (derived-mode . special-mode)
- (not (major-mode . help-mode)))
+ (not (major-mode . help-mode))
+ (not (derived-mode . gnus-mode)))
(derived-mode . compilation-mode)
(derived-mode . dired-mode)
(derived-mode . diff-mode)
@@ -1277,21 +1305,6 @@ Used by `project-kill-buffers'."
:package-version '(project . "0.8.2")
:safe #'booleanp)
-(defun project--buffer-list (pr)
- "Return the list of all buffers in project PR."
- (let ((conn (file-remote-p (project-root pr)))
- bufs)
- (dolist (buf (buffer-list))
- ;; For now we go with the assumption that a project must reside
- ;; entirely on one host. We might relax that in the future.
- (when (and (equal conn
- (file-remote-p (buffer-local-value 'default-directory
buf)))
- (equal pr
- (with-current-buffer buf
- (project-current))))
- (push buf bufs)))
- (nreverse bufs)))
-
(defun project--buffer-check (buf conditions)
"Check if buffer BUF matches any element of the list CONDITIONS.
See `project-kill-buffer-conditions' or
@@ -1667,9 +1680,10 @@ to directory DIR."
(let ((command (if (symbolp project-switch-commands)
project-switch-commands
(project--switch-project-command))))
- (let ((default-directory dir)
- (project-current-inhibit-prompt t))
- (call-interactively command))))
+ (with-temp-buffer
+ (let ((default-directory dir)
+ (project-current-inhibit-prompt t))
+ (call-interactively command)))))
(provide 'project)
;;; project.el ends here
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
index f8edc2b1f7..6e2c2513b0 100644
--- a/lisp/progmodes/prolog.el
+++ b/lisp/progmodes/prolog.el
@@ -1311,7 +1311,7 @@ With prefix argument ARG, restart the Prolog process if
running before."
(prolog-mode-variables)
))
-(defun prolog-inferior-guess-flavor (&optional ignored)
+(defun prolog-inferior-guess-flavor (&optional _ignored)
(setq-local prolog-system
(when (or (numberp prolog-system) (markerp prolog-system))
(save-excursion
diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el
index 89482d86ce..6355b17e4a 100644
--- a/lisp/progmodes/ps-mode.el
+++ b/lisp/progmodes/ps-mode.el
@@ -278,24 +278,22 @@ If nil, use `temporary-file-directory'."
;; Variables.
-(defvar ps-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-v" #'ps-run-boundingbox)
- (define-key map "\C-c\C-u" #'ps-mode-uncomment-region)
- (define-key map "\C-c\C-t" #'ps-mode-epsf-rich)
- (define-key map "\C-c\C-s" #'ps-run-start)
- (define-key map "\C-c\C-r" #'ps-run-region)
- (define-key map "\C-c\C-q" #'ps-run-quit)
- (define-key map "\C-c\C-p" #'ps-mode-print-buffer)
- (define-key map "\C-c\C-o" #'ps-mode-comment-out-region)
- (define-key map "\C-c\C-k" #'ps-run-kill)
- (define-key map "\C-c\C-j" #'ps-mode-other-newline)
- (define-key map "\C-c\C-l" #'ps-run-clear)
- (define-key map "\C-c\C-b" #'ps-run-buffer)
- ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead?
- (define-key map "\177" #'ps-mode-backward-delete-char)
- map)
- "Local keymap to use in PostScript mode.")
+(defvar-keymap ps-mode-map
+ :doc "Local keymap to use in PostScript mode."
+ "C-c C-v" #'ps-run-boundingbox
+ "C-c C-u" #'ps-mode-uncomment-region
+ "C-c C-t" #'ps-mode-epsf-rich
+ "C-c C-s" #'ps-run-start
+ "C-c C-r" #'ps-run-region
+ "C-c C-q" #'ps-run-quit
+ "C-c C-p" #'ps-mode-print-buffer
+ "C-c C-o" #'ps-mode-comment-out-region
+ "C-c C-k" #'ps-run-kill
+ "C-c C-j" #'ps-mode-other-newline
+ "C-c C-l" #'ps-run-clear
+ "C-c C-b" #'ps-run-buffer
+ ;; FIXME: Add `indent' to backward-delete-char-untabify-method instead?
+ "DEL" #'ps-mode-backward-delete-char)
(defvar ps-mode-syntax-table
(let ((st (make-syntax-table)))
@@ -332,15 +330,13 @@ If nil, use `temporary-file-directory'."
st)
"Syntax table used while in PostScript mode.")
-(defvar ps-run-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map comint-mode-map)
- (define-key map "\C-c\C-q" #'ps-run-quit)
- (define-key map "\C-c\C-k" #'ps-run-kill)
- (define-key map "\C-c\C-e" #'ps-run-goto-error)
- (define-key map [mouse-2] #'ps-run-mouse-goto-error)
- map)
- "Local keymap to use in PostScript run mode.")
+(defvar-keymap ps-run-mode-map
+ :doc "Local keymap to use in PostScript run mode."
+ :parent comint-mode-map
+ "C-c C-q" #'ps-run-quit
+ "C-c C-k" #'ps-run-kill
+ "C-c C-e" #'ps-run-goto-error
+ "<mouse-2>" #'ps-run-mouse-goto-error)
(defvar ps-mode-tmp-file nil
"Name of temporary file, set by `ps-run'.")
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index bb2aa37ca6..af59b8e146 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -3682,15 +3682,25 @@ detecting a prompt at the end of the buffer."
"Send STRING to PROCESS and inhibit output.
Return the output."
(or process (setq process (python-shell-get-process-or-error)))
- (cl-letf (((process-filter process)
- (lambda (_proc str)
- (with-current-buffer (process-buffer process)
- (python-shell-output-filter str))))
- (python-shell-output-filter-in-progress t)
- (inhibit-quit t))
+ (cl-letf* (((process-filter process)
+ (lambda (_proc str)
+ (with-current-buffer (process-buffer process)
+ (python-shell-output-filter str))))
+ (python-shell-output-filter-in-progress t)
+ (inhibit-quit t)
+ (buffer (process-buffer process))
+ (last-prompt (cond ((boundp 'comint-last-prompt-overlay)
+ 'comint-last-prompt-overlay)
+ ((boundp 'comint-last-prompt)
+ 'comint-last-prompt)))
+ (last-prompt-value (buffer-local-value last-prompt buffer)))
(or
(with-local-quit
- (python-shell-send-string string process)
+ (unwind-protect
+ (python-shell-send-string string process)
+ (when (not (null last-prompt))
+ (with-current-buffer buffer
+ (set last-prompt last-prompt-value))))
(while python-shell-output-filter-in-progress
;; `python-shell-output-filter' takes care of setting
;; `python-shell-output-filter-in-progress' to NIL after it
@@ -3699,7 +3709,7 @@ Return the output."
(prog1
python-shell-output-filter-buffer
(setq python-shell-output-filter-buffer nil)))
- (with-current-buffer (process-buffer process)
+ (with-current-buffer buffer
(comint-interrupt-subjob)))))
(defun python-shell-internal-send-string (string)
@@ -4328,7 +4338,8 @@ With argument MSG show activation/deactivation message."
Optional argument PROCESS forces completions to be retrieved
using that one instead of current buffer's process."
(setq process (or process (get-buffer-process (current-buffer))))
- (let* ((line-start (if (derived-mode-p 'inferior-python-mode)
+ (let* ((is-shell-buffer (derived-mode-p 'inferior-python-mode))
+ (line-start (if is-shell-buffer
;; Working on a shell buffer: use prompt end.
(cdr (python-util-comint-last-prompt))
(line-beginning-position)))
@@ -4338,15 +4349,18 @@ using that one instead of current buffer's process."
(buffer-substring-no-properties line-start (point)))
(buffer-substring-no-properties line-start (point))))
(start
- (save-excursion
- (if (not (re-search-backward
- (python-rx
- (or whitespace open-paren close-paren string-delimiter
simple-operator))
- line-start
- t 1))
- line-start
- (forward-char (length (match-string-no-properties 0)))
- (point))))
+ (if (< (point) line-start)
+ (point)
+ (save-excursion
+ (if (not (re-search-backward
+ (python-rx
+ (or whitespace open-paren close-paren
+ string-delimiter simple-operator))
+ line-start
+ t 1))
+ line-start
+ (forward-char (length (match-string-no-properties 0)))
+ (point)))))
(end (point))
(prompt-boundaries
(with-current-buffer (process-buffer process)
@@ -4359,7 +4373,11 @@ using that one instead of current buffer's process."
(completion-fn
(with-current-buffer (process-buffer process)
(cond ((or (null prompt)
- (< (point) (cdr prompt-boundaries)))
+ (and is-shell-buffer
+ (< (point) (cdr prompt-boundaries)))
+ (and (not is-shell-buffer)
+ (string-match-p
+ python-shell-prompt-pdb-regexp prompt)))
#'ignore)
((or (not python-shell-completion-native-enable)
;; Even if native completion is enabled, for
@@ -4626,7 +4644,9 @@ For this to work as best as possible you should call
`python-shell-send-buffer' from time to time so context in
inferior Python process is updated properly."
(let ((process (python-shell-get-process)))
- (when process
+ (when (and process
+ (python-shell-with-shell-buffer
+ (python-util-comint-end-of-output-p)))
(python-shell-completion-at-point process))))
(define-obsolete-function-alias
@@ -5051,6 +5071,8 @@ def __FFAP_get_module_path(objstr):
(defun python-ffap-module-path (module)
"Function for `ffap-alist' to return path for MODULE."
(when-let ((process (python-shell-get-process))
+ (ready (python-shell-with-shell-buffer
+ (python-util-comint-end-of-output-p)))
(module-file
(python-shell-send-string-no-output
(format "%s\nprint(__FFAP_get_module_path(%s))"
@@ -5169,7 +5191,9 @@ If not FORCE-INPUT is passed then what
`python-eldoc--get-symbol-at-point'
returns will be used. If not FORCE-PROCESS is passed what
`python-shell-get-process' returns is used."
(let ((process (or force-process (python-shell-get-process))))
- (when process
+ (when (and process
+ (python-shell-with-shell-buffer
+ (python-util-comint-end-of-output-p)))
(let* ((input (or force-input
(python-eldoc--get-symbol-at-point)))
(docstring
@@ -5731,6 +5755,7 @@ likely an invalid python file."
;; block and the current line, otherwise it
;; is not an opening block.
(save-excursion
+ (python-nav-end-of-statement)
(forward-line)
(let ((no-back-indent t))
(save-match-data
@@ -6024,6 +6049,13 @@ This is for compatibility with Emacs < 24.4."
comint-last-prompt)
(t nil)))
+(defun python-util-comint-end-of-output-p ()
+ "Return non-nil if the last prompt matches input prompt."
+ (when-let ((prompt (python-util-comint-last-prompt)))
+ (python-shell-comint-end-of-output-p
+ (buffer-substring-no-properties
+ (car prompt) (cdr prompt)))))
+
(defun python-util-forward-comment (&optional direction)
"Python mode specific version of `forward-comment'.
Optional argument DIRECTION defines the direction to move to."
diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el
index 955daa393c..17467b5554 100644
--- a/lisp/progmodes/ruby-mode.el
+++ b/lisp/progmodes/ruby-mode.el
@@ -849,7 +849,7 @@ The style of the comment is controlled by
`ruby-encoding-magic-comment-style'."
(back-to-indentation)
(current-column)))
-(defun ruby-indent-line (&optional ignored)
+(defun ruby-indent-line (&optional _ignored)
"Correct the indentation of the current Ruby line."
(interactive)
(ruby-indent-to (ruby-calculate-indent)))
@@ -1576,7 +1576,7 @@ With ARG, do it many times. Negative ARG means move
forward."
((error)))
i))))
-(defun ruby-indent-exp (&optional ignored)
+(defun ruby-indent-exp (&optional _ignored)
"Indent each line in the balanced expression following the point."
(interactive "*P")
(let ((here (point-marker)) start top column (nest t))
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index ed06f2263e..54f005508c 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -523,7 +523,7 @@ This is buffer-local in every such buffer.")
(rc . "\\<\\([[:alnum:]_*]+\\)[ \t]*=")
(sh . "\\<\\([[:alnum:]_]+\\)="))
"Regexp for the variable name and what may follow in an assignment.
-First grouping matches the variable name. This is upto and including the `='
+First grouping matches the variable name. This is up to and including the `='
sign. See `sh-feature'."
:type '(repeat (cons (symbol :tag "Shell")
(choice regexp
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
index 7e9aeab8fe..9aa8a994ed 100644
--- a/lisp/progmodes/simula.el
+++ b/lisp/progmodes/simula.el
@@ -1,7 +1,6 @@
;;; simula.el --- SIMULA 87 code editing commands for Emacs -*-
lexical-binding: t; -*-
-;; Copyright (C) 1992, 1994, 1996, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1992-2022 Free Software Foundation, Inc.
;; Author: Hans Henrik Eriksen <hhe@ifi.uio.no>
;; Maintainer: emacs-devel@gnu.org
@@ -246,31 +245,19 @@ for SIMULA mode to function correctly."
(defvar simula-font-lock-keywords simula-font-lock-keywords-1
"Default expressions to highlight in Simula mode.")
-; The following function is taken from cc-mode.el,
-; it determines the flavor of the Emacs running
-
-(defvar simula-mode-menu
- '(["Indent Line" simula-indent-line t]
- ["Backward Statement" simula-previous-statement t]
- ["Forward Statement" simula-next-statement t]
- ["Backward Up Level" simula-backward-up-level t]
- ["Forward Down Statement" simula-forward-down-level t])
- "Emacs menu for SIMULA mode.")
-
-(defvar simula-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-u" #'simula-backward-up-level)
- (define-key map "\C-c\C-p" #'simula-previous-statement)
- (define-key map "\C-c\C-d" #'simula-forward-down-level)
- (define-key map "\C-c\C-n" #'simula-next-statement)
- ;; (define-key map "\C-c\C-g" #'simula-goto-definition)
- ;; (define-key map "\C-c\C-h" #'simula-standard-help)
- (define-key map "\177" #'backward-delete-char-untabify)
- (define-key map ":" #'simula-electric-label)
- (define-key map "\e\C-q" #'simula-indent-exp)
- ;; (define-key map "\t" #'simula-indent-command)
- map)
- "Keymap used in `simula-mode'.")
+(defvar-keymap simula-mode-map
+ :doc "Keymap used in `simula-mode'."
+ "C-c C-u" #'simula-backward-up-level
+ "C-c C-p" #'simula-previous-statement
+ "C-c C-d" #'simula-forward-down-level
+ "C-c C-n" #'simula-next-statement
+ ;; "C-c C-g" #'simula-goto-definition
+ ;; "C-c C-h" #'simula-standard-help
+ "DEL" #'backward-delete-char-untabify
+ ":" #'simula-electric-label
+ "C-M-q" #'simula-indent-exp
+ ;; "TAB" #'simula-indent-command
+ )
(easy-menu-define simula-mode-menu simula-mode-map
"Menu for `simula-mode'."
@@ -1560,7 +1547,6 @@ If not nil and not t, move to limit of search and return
nil."
(let (abbrevs-changed)
(simula-install-standard-abbrevs))
-;; Hilit mode support.
;; obsolete
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index b950f93f2a..e585799dc6 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -781,7 +781,7 @@ host key."
;; Perform search
(dolist (s (auth-source-search :max 1000))
(when (and
- ;; Is PRODUCT specified, in the enty, and they are equal
+ ;; Is PRODUCT specified, in the entry, and they are equal
(if product
(if (plist-member s :product)
(equal (plist-get s :product) product)
@@ -1358,37 +1358,33 @@ specified, it's `sql-product' or `sql-connection' must
match."
;; Keymap for sql-interactive-mode.
-(defvar sql-interactive-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map comint-mode-map)
- (define-key map (kbd "C-j") 'sql-accumulate-and-indent)
- (define-key map (kbd "C-c C-w") 'sql-copy-column)
- (define-key map (kbd "O") 'sql-magic-go)
- (define-key map (kbd "o") 'sql-magic-go)
- (define-key map (kbd ";") 'sql-magic-semicolon)
- (define-key map (kbd "C-c C-l a") 'sql-list-all)
- (define-key map (kbd "C-c C-l t") 'sql-list-table)
- map)
- "Mode map used for `sql-interactive-mode'.
-Based on `comint-mode-map'.")
+(defvar-keymap sql-interactive-mode-map
+ :doc "Mode map used for `sql-interactive-mode'.
+Based on `comint-mode-map'."
+ :parent comint-mode-map
+ "C-j" #'sql-accumulate-and-indent
+ "C-c C-w" #'sql-copy-column
+ "O" #'sql-magic-go
+ "o" #'sql-magic-go
+ ";" #'sql-magic-semicolon
+ "C-c C-l a" #'sql-list-all
+ "C-c C-l t" #'sql-list-table)
;; Keymap for sql-mode.
-(defvar sql-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c C-c") 'sql-send-paragraph)
- (define-key map (kbd "C-c C-r") 'sql-send-region)
- (define-key map (kbd "C-c C-s") 'sql-send-string)
- (define-key map (kbd "C-c C-b") 'sql-send-buffer)
- (define-key map (kbd "C-c C-n") 'sql-send-line-and-next)
- (define-key map (kbd "C-c C-i") 'sql-product-interactive)
- (define-key map (kbd "C-c C-z") 'sql-show-sqli-buffer)
- (define-key map (kbd "C-c C-l a") 'sql-list-all)
- (define-key map (kbd "C-c C-l t") 'sql-list-table)
- (define-key map [remap beginning-of-defun] 'sql-beginning-of-statement)
- (define-key map [remap end-of-defun] 'sql-end-of-statement)
- map)
- "Mode map used for `sql-mode'.")
+(defvar-keymap sql-mode-map
+ :doc "Mode map used for `sql-mode'."
+ "C-c C-c" #'sql-send-paragraph
+ "C-c C-r" #'sql-send-region
+ "C-c C-s" #'sql-send-string
+ "C-c C-b" #'sql-send-buffer
+ "C-c C-n" #'sql-send-line-and-next
+ "C-c C-i" #'sql-product-interactive
+ "C-c C-z" #'sql-show-sqli-buffer
+ "C-c C-l a" #'sql-list-all
+ "C-c C-l t" #'sql-list-table
+ "<remap> <beginning-of-defun>" #'sql-beginning-of-statement
+ "<remap> <end-of-defun>" #'sql-end-of-statement)
;; easy menu for sql-mode.
@@ -3030,9 +3026,10 @@ displayed."
;; Our start must be between them
(goto-char last)
- ;; Find a beginning-of-stmt that's not in a comment
+ ;; Find a beginning-of-stmt that's not in a string or comment
(while (and (re-search-forward regexp next t 1)
- (nth 7 (syntax-ppss)))
+ (or (nth 3 (syntax-ppss))
+ (nth 7 (syntax-ppss))))
(goto-char (match-end 0)))
(goto-char
(if (match-data)
@@ -3062,8 +3059,9 @@ displayed."
;; If we found another end-of-stmt
(if (not (apply re-search term nil t n nil))
(setq arg 0)
- ;; count it if we're not in a comment
- (unless (nth 7 (syntax-ppss))
+ ;; count it if we're not in a string or comment
+ (unless (or (nth 3 (syntax-ppss))
+ (nth 7 (syntax-ppss)))
(setq arg (- arg (cl-signum arg))))))
(goto-char (if (match-data)
(match-end 0)
diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el
index fa799a0fb3..e5458e6a07 100644
--- a/lisp/progmodes/verilog-mode.el
+++ b/lisp/progmodes/verilog-mode.el
@@ -3409,7 +3409,8 @@ A change is considered significant if it affects the
buffer text
in any way that isn't completely restored again. Any
user-visible changes to the buffer must not be within a
`verilog-save-buffer-state'."
- `(let ((inhibit-point-motion-hooks t)
+ `(let (,@(unless (>= emacs-major-version 25)
+ '((inhibit-point-motion-hooks t)))
(verilog-no-change-functions t))
,(if (fboundp 'with-silent-modifications)
`(with-silent-modifications ,@body)
@@ -3455,11 +3456,13 @@ For insignificant changes, see instead
`verilog-save-buffer-state'."
(run-hook-with-args 'before-change-functions (point-min) (point-max))
(unwind-protect
;; Must inhibit and restore hooks before restoring font-lock
- (let* ((inhibit-point-motion-hooks t)
+ (let* (,@(unless (>= emacs-major-version 25)
+ '((inhibit-point-motion-hooks t) ;Obsolete since 25.1
+ ;; XEmacs and pre-Emacs 21 ignore
+ ;; `inhibit-modification-hooks'.
+ before-change-functions after-change-functions))
(inhibit-modification-hooks t)
- (verilog-no-change-functions t)
- ;; XEmacs and pre-Emacs 21 ignore inhibit-modification-hooks.
- before-change-functions after-change-functions)
+ (verilog-no-change-functions t))
(progn ,@body))
;; Unwind forms
(run-hook-with-args 'after-change-functions (point-min) (point-max)
@@ -7716,7 +7719,7 @@ nil otherwise."
(setq match t)
(setq elm nil))
(setq elm (cdr elm)))))
- ;; If this is a test just for exact match, return nil ot t
+ ;; If this is a test just for exact match, return nil or t
(if (and (equal flag 'lambda) (not (equal match 't)))
nil
match))))
@@ -9627,7 +9630,7 @@ Returns REGEXP and list of ( (signal_name
connection_name)... )."
(defun verilog-read-auto-template (module)
"Look for an auto_template for the instantiation of the given MODULE.
-If found returns `verilog-read-auto-template-inside' structure."
+If found returns `verilog-read-auto-template-middle' structure."
(save-excursion
;; Find beginning
(let ((pt (point)))
@@ -10021,7 +10024,7 @@ Used for __FLAGS__ in `verilog-expand-command'."
(defvar verilog-dir-cache-preserving nil
"If true, the directory cache is enabled, and file system changes are
ignored.
-See `verilog-dir-exists-p' and `verilog-dir-files'.")
+See `verilog-dir-file-exists-p' and `verilog-dir-files'.")
;; If adding new cached variable, add also to verilog-preserve-dir-cache
(defvar verilog-dir-cache-list nil
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el
index b763da3fbc..a36bb7fbe4 100644
--- a/lisp/progmodes/vhdl-mode.el
+++ b/lisp/progmodes/vhdl-mode.el
@@ -2507,11 +2507,10 @@ consistent searching."
(defmacro vhdl-prepare-search-2 (&rest body)
"Enable case insensitive search, switch to syntax table that includes `_',
-arrange to ignore `intangible' overlays, then execute BODY, and finally restore
-the old environment. Used for consistent searching."
+then execute BODY, and finally restore the old environment.
+Used for consistent searching."
(declare (debug t))
- `(let ((case-fold-search t) ; case insensitive search
- (inhibit-point-motion-hooks t))
+ `(let ((case-fold-search t)) ; case insensitive search
;; use extended syntax table
(with-syntax-table vhdl-mode-ext-syntax-table
;; execute BODY safely
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index ac04b64ce5..89a090ae93 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -751,17 +751,22 @@ quit the *xref* buffer."
(defun xref-query-replace-in-results (from to)
"Perform interactive replacement of FROM with TO in all displayed xrefs.
-This command interactively replaces FROM with TO in the names of the
+This function interactively replaces FROM with TO in the names of the
references displayed in the current *xref* buffer.
-When called interactively, it uses '.*' as FROM, which means
-replace the whole name. Unless called with prefix argument, in
-which case the user is prompted for both FROM and TO.
+When called interactively, it uses '.*' as FROM, which means replace
+the whole name, and prompts the user for TO.
+If invoked with prefix argument, it prompts the user for both FROM and TO.
As each match is found, the user must type a character saying
what to do with it. Type SPC or `y' to replace the match,
DEL or `n' to skip and go to the next match. For more directions,
-type \\[help-command] at that time."
+type \\[help-command] at that time.
+
+Note that this function cannot be used in *xref* buffers that show
+a partial list of all references, such as the *xref* buffer created
+by \\[xref-find-definitions] and its variants, since those list only
+some of the references to the identifiers."
(interactive
(let* ((fr
(if current-prefix-arg
@@ -891,7 +896,9 @@ ITEMS is an xref item which " ; FIXME: Expand documentation.
(setq pairs (cdr buf-pairs))
(setq continue
(perform-replace from to t t nil nil multi-query-replace-map)))
- (unless did-it-once (user-error "No suitable matches here"))
+ (unless did-it-once
+ (user-error
+ "Cannot perform global renaming of symbols using find-definition
results"))
(when (and continue (not buf-pairs))
(message "All results processed"))))
@@ -1230,16 +1237,21 @@ local keymap that binds `RET' to
`xref-quit-and-goto-xref'."
(max-height (/ (window-height) 2))
(size-fun (lambda (window)
(fit-window-to-buffer window max-height)))
+ xref-alist
buf)
(cond
((not (cdr xrefs))
(xref-pop-to-location (car xrefs)
(assoc-default 'display-action alist)))
(t
+ ;; Call it here because it can call (project-current), and that
+ ;; might depend on individual buffer, not just directory.
+ (setq xref-alist (xref--analyze xrefs))
+
(with-current-buffer (get-buffer-create xref-buffer-name)
(xref--ensure-default-directory dd (current-buffer))
(xref--transient-buffer-mode)
- (xref--show-common-initialize (xref--analyze xrefs) fetcher alist)
+ (xref--show-common-initialize xref-alist fetcher alist)
(pop-to-buffer (current-buffer)
`(display-buffer-in-direction . ((direction . below)
(window-height .
,size-fun))))
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 0ae68d6024..33e8d98ce3 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -582,28 +582,57 @@ Used in `repeat-mode'."
(push s (alist-get (get s 'repeat-map) keymaps)))))
(with-help-window (help-buffer)
(with-current-buffer standard-output
- (insert "A list of keymaps used by commands with the symbol property
`repeat-map'.\n\n")
+ (insert "A list of keymaps used by commands with the symbol property
`repeat-map'.\n")
(dolist (keymap (sort keymaps (lambda (a b)
(when (and (symbolp (car a))
(symbolp (car b)))
- (string-lessp (car a) (car b))))))
- (insert (format-message
- "`%s' keymap is repeatable by these commands:\n"
- (car keymap)))
- (dolist (command (sort (cdr keymap) #'string-lessp))
- (let* ((info (help-fns--analyze-function command))
- (map (list (if (symbolp (car keymap))
- (symbol-value (car keymap))
- (car keymap))))
- (desc (mapconcat (lambda (key)
- (propertize (key-description key)
- 'face 'help-key-binding))
- (or (where-is-internal command map)
- (where-is-internal (nth 3 info) map))
- ", ")))
- (insert (format-message " `%s' (bound to %s)\n" command
desc))))
- (insert "\n")))))))
+ (string< (car a) (car b))))))
+ (insert (format-message "\f\n* `%s'\n" (car keymap)))
+ (when (symbolp (car keymap))
+ (insert (substitute-command-keys (format-message "\\{%s}" (car
keymap)))))
+
+ (let* ((map (if (symbolp (car keymap))
+ (symbol-value (car keymap))
+ (car keymap)))
+ (repeat-commands (cdr keymap))
+ map-commands commands-enter commands-exit)
+ (map-keymap (lambda (_key cmd)
+ (when (symbolp cmd) (push cmd map-commands)))
+ map)
+ (setq map-commands (seq-uniq map-commands))
+ (setq commands-enter (seq-difference repeat-commands
map-commands))
+ (setq commands-exit (seq-difference map-commands
repeat-commands))
+
+ (when (or commands-enter commands-exit)
+ (when commands-enter
+ (insert "\n** Entered with:\n\n")
+ (fill-region-as-paragraph
+ (point)
+ (progn
+ (insert (mapconcat (lambda (cmd)
+ (format-message "`%s'" cmd))
+ (sort commands-enter #'string<)
+ ", "))
+ (point)))
+ (insert "\n"))
+ (when commands-exit
+ (insert "\n** Exited with:\n\n")
+ (fill-region-as-paragraph
+ (point)
+ (progn
+ (insert (mapconcat (lambda (cmd)
+ (format-message "`%s'" cmd))
+ (sort commands-exit #'string<)
+ ", "))
+ (point)))
+ (insert "\n")))))
+
+ ;; Hide ^Ls.
+ (goto-char (point-min))
+ (while (search-forward "\n\f\n" nil t)
+ (put-text-property (1+ (match-beginning 0)) (1- (match-end 0))
+ 'invisible t)))))))
(provide 'repeat)
diff --git a/lisp/replace.el b/lisp/replace.el
index 8f81ec33a6..c7ae77d128 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -2818,7 +2818,7 @@ see the documentation of `replace-match' to find out how
to simulate
`case-replace'.
This function returns nil if there were no matches to make, or
-the user cancelled the call.
+the user canceled the call.
REPLACEMENTS is either a string, a list of strings, or a cons cell
containing a function and its first argument. The function is
diff --git a/lisp/rot13.el b/lisp/rot13.el
index c063725de8..5d1c46e483 100644
--- a/lisp/rot13.el
+++ b/lisp/rot13.el
@@ -85,9 +85,16 @@ and END, and return the encrypted string."
;;;###autoload
(defun rot13-region (start end)
- "ROT13 encrypt the region between START and END in current buffer."
+ "ROT13 encrypt the region between START and END in current buffer.
+If invoked interactively and the buffer is read-only, a message
+will be printed instead."
(interactive "r")
- (translate-region start end rot13-translate-table))
+ (condition-case nil
+ (translate-region start end rot13-translate-table)
+ (buffer-read-only
+ (when (called-interactively-p 'interactive)
+ (let ((dec (rot13-string (buffer-substring start end))))
+ (message "Buffer is read-only:\n%s" (string-trim dec)))))))
;;;###autoload
(defun rot13-other-window ()
diff --git a/lisp/savehist.el b/lisp/savehist.el
index 8924c8dde2..f1d3e50d94 100644
--- a/lisp/savehist.el
+++ b/lisp/savehist.el
@@ -1,6 +1,6 @@
;;; savehist.el --- Save minibuffer history -*- lexical-binding:t -*-
-;; Copyright (C) 1997, 2005-2022 Free Software Foundation, Inc.
+;; Copyright (C) 1997-2022 Free Software Foundation, Inc.
;; Author: Hrvoje Nikšić <hrvoje.niksic@avl.com>
;; Maintainer: emacs-devel@gnu.org
@@ -41,10 +41,6 @@
;; You can also explicitly save history with `M-x savehist-save' and
;; load it by loading the `savehist-file' with `M-x load-file'.
-;; If you are using a version of Emacs that does not ship with this
-;; package, be sure to have `savehist.el' in a directory that is in
-;; your load-path, and to byte-compile it.
-
;;; Code:
;; User variables
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
index 5786a21e88..dbe2b6241f 100644
--- a/lisp/scroll-bar.el
+++ b/lisp/scroll-bar.el
@@ -390,7 +390,7 @@ EVENT should be a scroll bar click."
(setq point-before-scroll before-scroll)))))
-;;; Tookit scroll bars.
+;;; Toolkit scroll bars.
(defun scroll-bar-toolkit-scroll (event)
"Handle event EVENT on vertical scroll bar."
diff --git a/lisp/server.el b/lisp/server.el
index 3caa335c4e..2973b783e6 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -670,7 +670,6 @@ the `server-process' variable."
"/tmp/")
(ignore-errors
(delete-directory (file-name-directory server-file))))))
- (setq server-mode nil) ;; already set by the minor mode code
(display-warning
'server
(concat "Unable to start the Emacs server.\n"
@@ -688,7 +687,9 @@ server or call `\\[server-force-delete]' to forcibly
disconnect it."))
(if leave-dead
(progn
(unless (eq t leave-dead) (server-log (message "Server stopped")))
- (setq server-process nil))
+ (setq server-mode nil
+ global-minor-modes (delq 'server-mode global-minor-modes)
+ server-process nil))
;; Make sure there is a safe directory in which to place the socket.
(server-ensure-safe-dir server-dir)
(when server-process
@@ -716,7 +717,10 @@ server or call `\\[server-force-delete]' to forcibly
disconnect it."))
;; Those are decoded by server-process-filter according
;; to file-name-coding-system. Also don't get
;; confused by CRs since we don't quote them.
- :coding 'raw-text-unix
+ ;; For encoding, we must use the locale's encoding,
+ ;; since emacsclient shows that verbatim on the
+ ;; console.
+ :coding (cons 'raw-text-unix locale-coding-system)
;; The other args depend on the kind of socket used.
(if server-use-tcp
(list :family 'ipv4 ;; We're not ready for IPv6 yet
@@ -728,6 +732,8 @@ server or call `\\[server-force-delete]' to forcibly
disconnect it."))
:plist '(:authenticated t)))))
(unless server-process (error "Could not start server process"))
(process-put server-process :server-file server-file)
+ (setq server-mode t)
+ (push 'server-mode global-minor-modes)
(when server-use-tcp
(let ((auth-key (server-get-auth-key)))
(process-put server-process :auth-key auth-key)
@@ -796,6 +802,10 @@ by the current Emacs process, use the `server-process'
variable."
t)
(file-error nil)))
+;; This keymap is empty, but allows users to define keybindings to use
+;; when `server-mode' is active.
+(defvar-keymap server-mode-map)
+
;;;###autoload
(define-minor-mode server-mode
"Toggle Server mode.
@@ -805,6 +815,7 @@ Server mode runs a process that accepts commands from the
`server-start' for details."
:global t
:version "22.1"
+ :keymap server-mode-map
;; Fixme: Should this check for an existing server socket and do
;; nothing if there is one (for multiple Emacs sessions)?
(server-start (not server-mode)))
@@ -1589,14 +1600,19 @@ specifically for the clients and did not exist before
their request for it."
(server-buffer-done (current-buffer))))
(defun server-kill-emacs-query-function ()
- "Ask before exiting Emacs if it has live clients.
+ "Ask before exiting Emacs if it has other live clients.
A \"live client\" is a client with at least one live buffer
-associated with it."
- (or (not (seq-some (lambda (proc)
- (seq-some #'buffer-live-p
- (process-get proc 'buffers)))
- server-clients))
- (yes-or-no-p "This Emacs session has clients; exit anyway? ")))
+associated with it. These clients were (probably) started by
+external processes that are waiting for some buffers to be
+edited. If there are any other clients, we don't want to fail
+their waiting processes, so ask the user to be sure."
+ (let ((this-client (frame-parameter nil 'client)))
+ (or (not (seq-some (lambda (proc)
+ (unless (eq proc this-client)
+ (seq-some #'buffer-live-p
+ (process-get proc 'buffers))))
+ server-clients))
+ (yes-or-no-p "This Emacs session has other clients; exit anyway? "))))
(defun server-kill-buffer ()
"Remove the current buffer from its clients' buffer list.
diff --git a/lisp/shell.el b/lisp/shell.el
index 641f274045..7c3c925ab8 100644
--- a/lisp/shell.el
+++ b/lisp/shell.el
@@ -393,6 +393,14 @@ Useful for shells like zsh that has this feature."
'complete-expand)
map))
+(defvar-keymap shell-repeat-map
+ :doc "Keymap to repeat shell key sequences. Used in `repeat-mode'."
+ "C-f" #'shell-forward-command
+ "C-b" #'shell-backward-command)
+
+(put #'shell-forward-command 'repeat-map 'shell-repeat-map)
+(put #'shell-backward-command 'repeat-map 'shell-repeat-map)
+
(defcustom shell-mode-hook '()
"Hook for customizing Shell mode."
:type 'hook
diff --git a/lisp/simple.el b/lisp/simple.el
index 6b73ccb516..0f44b14948 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2465,9 +2465,13 @@ Also see `suggest-key-bindings'."
(defun execute-extended-command--shorter (name typed)
(let ((candidates '())
+ commands
(max (length typed))
(len 1)
binding)
+ ;; Precompute a list of commands once to avoid repeated `commandp' testing
+ ;; of symbols in the `completion-try-completion' call inside the loop below
+ (mapatoms (lambda (s) (when (commandp s) (push s commands))))
(while (and (not binding)
(progn
(unless candidates
@@ -2480,16 +2484,22 @@ Also see `suggest-key-bindings'."
(input-pending-p) ;Dummy call to trigger input-processing, bug#23002.
(let ((candidate (pop candidates)))
(when (equal name
- (car-safe (completion-try-completion
- candidate obarray 'commandp len)))
+ (car-safe (completion-try-completion
+ candidate commands nil len)))
(setq binding candidate))))
binding))
(defvar execute-extended-command--binding-timer nil)
+(defun execute-extended-command--describe-binding-msg (function binding
shorter)
+ (format-message "You can run the command `%s' with %s"
+ function
+ (propertize (cond (shorter (concat "M-x " shorter))
+ ((stringp binding) binding)
+ (t (key-description binding)))
+ 'face 'help-key-binding)))
+
(defun execute-extended-command (prefixarg &optional command-name typed)
- ;; Based on Fexecute_extended_command in keyboard.c of Emacs.
- ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24
"Read a command name, then read the arguments and call the command.
To pass a prefix argument to the command you are
invoking, give a prefix argument to `execute-extended-command'."
@@ -2512,7 +2522,7 @@ invoking, give a prefix argument to
`execute-extended-command'."
(not executing-kbd-macro)
(where-is-internal function overriding-local-map t)))
(delay-before-suggest 0)
- (find-shorter nil))
+ find-shorter shorter)
(unless (commandp function)
(error "`%s' is not a valid command name" command-name))
;; If we're executing a command that's remapped, we can't actually
@@ -2536,11 +2546,11 @@ invoking, give a prefix argument to
`execute-extended-command'."
;; flight.
(when execute-extended-command--binding-timer
(cancel-timer execute-extended-command--binding-timer))
- ;; If this command displayed something in the echo area, then
- ;; postpone the display of our suggestion message a bit.
(when (and suggest-key-bindings
(or binding
(and extended-command-suggest-shorter typed)))
+ ;; If this command displayed something in the echo area, then
+ ;; postpone the display of our suggestion message a bit.
(setq delay-before-suggest
(cond
((zerop (length (current-message))) 0)
@@ -2552,7 +2562,7 @@ invoking, give a prefix argument to
`execute-extended-command'."
(symbolp function)
(> (length (symbol-name function)) 2))
;; There's no binding for CMD. Let's try and find the shortest
- ;; string to use in M-x.
+ ;; string to use in M-x. But don't actually do anything yet.
(setq find-shorter t))
(when (or binding find-shorter)
(setq execute-extended-command--binding-timer
@@ -2566,15 +2576,12 @@ invoking, give a prefix argument to
`execute-extended-command'."
(when find-shorter
(while-no-input
;; FIXME: Can be slow. Cache it maybe?
- (setq binding (execute-extended-command--shorter
+ (setq shorter (execute-extended-command--shorter
(symbol-name function) typed))))
- (when binding
+ (when (or binding shorter)
(with-temp-message
- (format-message "You can run the command `%s' with %s"
- function
- (if (stringp binding)
- (concat "M-x " binding " RET")
- (key-description binding)))
+ (execute-extended-command--describe-binding-msg
+ function binding shorter)
(sit-for (if (numberp suggest-key-bindings)
suggest-key-bindings
2))))))))))))
@@ -2643,10 +2650,7 @@ function as needed."
((or `(lambda ,_args . ,body) `(closure ,_env ,_args . ,body)
`(autoload ,_file . ,body))
(let ((doc (car body)))
- (when (and (funcall docstring-p doc)
- ;; Handle a doc reference--but these never come last
- ;; in the function body, so reject them if they are last.
- (or (cdr body) (eq 'autoload (car-safe function))))
+ (when (funcall docstring-p doc)
doc)))
(_ (signal 'invalid-function (list function))))))
@@ -3526,8 +3530,6 @@ Return what remains of the list."
;; In a writable buffer, enable undoing read-only text that is
;; so because of text properties.
(inhibit-read-only t)
- ;; Don't let `intangible' properties interfere with undo.
- (inhibit-point-motion-hooks t)
;; We use oldlist only to check for EQ. ++kfs
(oldlist buffer-undo-list)
(did-apply nil)
@@ -7839,7 +7841,9 @@ If NOERROR, don't signal an error if we can't move that
many lines."
(defun line-move-1 (arg &optional noerror _to-end)
;; Don't run any point-motion hooks, and disregard intangibility,
;; for intermediate positions.
- (let ((inhibit-point-motion-hooks t)
+ (with-suppressed-warnings ((obsolete inhibit-point-motion-hooks))
+ (let ((outer-ipmh inhibit-point-motion-hooks)
+ (inhibit-point-motion-hooks t)
(opoint (point))
(orig-arg arg))
(if (consp temporary-goal-column)
@@ -7951,20 +7955,20 @@ If NOERROR, don't signal an error if we can't move that
many lines."
;; point-left-hooks.
(let* ((npoint (prog1 (line-end-position)
(goto-char opoint)))
- (inhibit-point-motion-hooks nil))
+ (inhibit-point-motion-hooks outer-ipmh))
(goto-char npoint)))
((< arg 0)
;; If we did not move up as far as desired,
;; at least go to beginning of line.
(let* ((npoint (prog1 (line-beginning-position)
(goto-char opoint)))
- (inhibit-point-motion-hooks nil))
+ (inhibit-point-motion-hooks outer-ipmh))
(goto-char npoint)))
(t
(line-move-finish (or goal-column temporary-goal-column)
- opoint (> orig-arg 0)))))))
+ opoint (> orig-arg 0) (not outer-ipmh))))))))
-(defun line-move-finish (column opoint forward)
+(defun line-move-finish (column opoint forward &optional not-ipmh)
(let ((repeat t))
(while repeat
;; Set REPEAT to t to repeat the whole thing.
@@ -8015,42 +8019,44 @@ If NOERROR, don't signal an error if we can't move that
many lines."
;; unnecessarily. Note that we move *forward* past intangible
;; text when the initial and final points are the same.
(goto-char new)
- (let ((inhibit-point-motion-hooks nil))
- (goto-char new)
-
- ;; If intangibility moves us to a different (later) place
- ;; in the same line, use that as the destination.
- (if (<= (point) line-end)
- (setq new (point))
- ;; If that position is "too late",
- ;; try the previous allowable position.
- ;; See if it is ok.
- (backward-char)
- (if (if forward
- ;; If going forward, don't accept the previous
- ;; allowable position if it is before the target line.
- (< line-beg (point))
- ;; If going backward, don't accept the previous
- ;; allowable position if it is still after the target line.
- (<= (point) line-end))
- (setq new (point))
- ;; As a last resort, use the end of the line.
- (setq new line-end))))
+ (with-suppressed-warnings ((obsolete inhibit-point-motion-hooks))
+ (let ((inhibit-point-motion-hooks (not not-ipmh)))
+ (goto-char new)
+
+ ;; If intangibility moves us to a different (later) place
+ ;; in the same line, use that as the destination.
+ (if (<= (point) line-end)
+ (setq new (point))
+ ;; If that position is "too late",
+ ;; try the previous allowable position.
+ ;; See if it is ok.
+ (backward-char)
+ (if (if forward
+ ;; If going forward, don't accept the previous
+ ;; allowable position if it is before the target line.
+ (< line-beg (point))
+ ;; If going backward, don't accept the previous
+ ;; allowable position if it is still after the target line.
+ (<= (point) line-end))
+ (setq new (point))
+ ;; As a last resort, use the end of the line.
+ (setq new line-end)))))
;; Now move to the updated destination, processing fields
;; as well as intangibility.
(goto-char opoint)
- (let ((inhibit-point-motion-hooks nil))
- (goto-char
- ;; Ignore field boundaries if the initial and final
- ;; positions have the same `field' property, even if the
- ;; fields are non-contiguous. This seems to be "nicer"
- ;; behavior in many situations.
- (if (eq (get-char-property new 'field)
- (get-char-property opoint 'field))
- new
- (constrain-to-field new opoint t t
- 'inhibit-line-move-field-capture))))
+ (with-suppressed-warnings ((obsolete inhibit-point-motion-hooks))
+ (let ((inhibit-point-motion-hooks (not not-ipmh)))
+ (goto-char
+ ;; Ignore field boundaries if the initial and final
+ ;; positions have the same `field' property, even if the
+ ;; fields are non-contiguous. This seems to be "nicer"
+ ;; behavior in many situations.
+ (if (eq (get-char-property new 'field)
+ (get-char-property opoint 'field))
+ new
+ (constrain-to-field new opoint t t
+ 'inhibit-line-move-field-capture)))))
;; If all this moved us to a different line,
;; retry everything within that new line.
diff --git a/lisp/so-long.el b/lisp/so-long.el
index 75201fefca..661f5ee57a 100644
--- a/lisp/so-long.el
+++ b/lisp/so-long.el
@@ -839,7 +839,7 @@ was established."
)
;; It's not clear to me whether all of these would be problematic, but they
;; seemed like reasonable targets. Some are certainly excessive in smaller
- ;; buffers of minified code, but we should be aiming to maximise performance
+ ;; buffers of minified code, but we should be aiming to maximize performance
;; by default, so that Emacs is as responsive as we can manage in even very
;; large buffers of minified code.
"List of buffer-local minor modes to explicitly disable.
@@ -880,7 +880,7 @@ If `so-long-revert' is subsequently invoked, then the
variables are restored
to their original states.
The combination of `line-move-visual' (enabled) and `truncate-lines' (disabled)
-is important for maximising responsiveness when moving vertically within an
+is important for maximizing responsiveness when moving vertically within an
extremely long line, as otherwise the full length of the line may need to be
scanned to find the next position.
diff --git a/lisp/startup.el b/lisp/startup.el
index 04de7e42fe..5e0a47d3f8 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -458,7 +458,8 @@ or `CVS', and any subdirectory that contains a file named
`.nosearch'."
;; The Windows version doesn't report meaningful inode numbers, so
;; use the canonicalized absolute file name of the directory instead.
(setq attrs (or canonicalized
- (nthcdr 10 (file-attributes this-dir))))
+ (file-attribute-file-identifier
+ (file-attributes this-dir))))
(unless (member attrs normal-top-level-add-subdirs-inode-list)
(push attrs normal-top-level-add-subdirs-inode-list)
(dolist (file contents)
@@ -1062,19 +1063,30 @@ init-file, or to a default value if loading is not
possible."
;; If we loaded a compiled file, set `user-init-file' to
;; the source version if that exists.
- (when (equal (file-name-extension user-init-file)
- "elc")
- (let* ((source (file-name-sans-extension user-init-file))
- (alt (concat source ".el")))
- (setq source (cond ((file-exists-p alt) alt)
- ((file-exists-p source) source)
- (t nil)))
- (when source
- (when (file-newer-than-file-p source user-init-file)
- (message "Warning: %s is newer than %s"
- source user-init-file)
- (sit-for 1))
- (setq user-init-file source))))
+ (if (equal (file-name-extension user-init-file) "elc")
+ (let* ((source (file-name-sans-extension user-init-file))
+ (alt (concat source ".el")))
+ (setq source (cond ((file-exists-p alt) alt)
+ ((file-exists-p source) source)
+ (t nil)))
+ (when source
+ (when (file-newer-than-file-p source user-init-file)
+ (message "Warning: %s is newer than %s"
+ source user-init-file)
+ (sit-for 1))
+ (setq user-init-file source)))
+ ;; Else, perhaps the user init file was compiled
+ (when (and (equal (file-name-extension user-init-file) "eln")
+ ;; The next test is for builds without native
+ ;; compilation support or builds with unexec.
+ (boundp 'comp-eln-to-el-h))
+ (if-let (source (gethash (file-name-nondirectory
user-init-file)
+ comp-eln-to-el-h))
+ ;; source exists or the .eln file would not load
+ (setq user-init-file source)
+ (message "Warning: unknown source file for init file %S"
+ user-init-file)
+ (sit-for 1))))
(when (and load-defaults
(not inhibit-default-init))
@@ -1197,7 +1209,7 @@ please check its value")
("--user") ("--iconic") ("--icon-type") ("--quick")
("--no-blinking-cursor") ("--basic-display")
("--dump-file") ("--temacs") ("--seccomp")
- ("--init-directory")))
+ ("--init-directory" "--no-comp-spawn")))
(argi (pop args))
(orig-argi argi)
argval)
@@ -1254,6 +1266,9 @@ please check its value")
((equal argi "-no-site-file")
(setq site-run-file nil)
(put 'site-run-file 'standard-value '(nil)))
+ ((equal argi "-no-comp-spawn")
+ (defvar comp-no-spawn)
+ (setq comp-no-spawn t))
((equal argi "-debug-init")
(setq init-file-debug t))
((equal argi "-iconic")
diff --git a/lisp/subr.el b/lisp/subr.el
index c975c216bb..261ec512d8 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -161,16 +161,18 @@ of previous VARs.
`(progn . ,(nreverse exps))))
(defmacro setq-local (&rest pairs)
- "Make variables in PAIRS buffer-local and assign them the corresponding
values.
+ "Make each VARIABLE buffer-local and assign to it the corresponding VALUE.
-PAIRS is a list of variable/value pairs. For each variable, make
-it buffer-local and assign it the corresponding value. The
-variables are literal symbols and should not be quoted.
+The arguments are variable/value pairs For each VARIABLE in a pair,
+make VARIABLE buffer-local and assign to it the corresponding VALUE
+of the pair. The VARIABLEs are literal symbols and should not be quoted.
-The second VALUE is not computed until after the first VARIABLE
-is set, and so on; each VALUE can use the new value of variables
-set earlier in the `setq-local'. The return value of the
-`setq-local' form is the value of the last VALUE.
+The VALUE of the Nth pair is not computed until after the VARIABLE
+of the (N-1)th pair is set; thus, each VALUE can use the new VALUEs
+of VARIABLEs set by earlier pairs.
+
+The return value of the `setq-local' form is the VALUE of the last
+pair.
\(fn [VARIABLE VALUE]...)"
(declare (debug setq))
@@ -344,7 +346,7 @@ in compilation warnings about unused variables.
;; FIXME: This let often leads to "unused var" warnings.
`((let ((,var ,counter)) ,@(cddr spec)))))))
-(defmacro declare (&rest _specs)
+(defmacro declare (&rest specs)
"Do not evaluate any arguments, and return nil.
If a `declare' form appears as the first form in the body of a
`defun' or `defmacro' form, SPECS specifies various additional
@@ -355,8 +357,16 @@ The possible values of SPECS are specified by
`defun-declarations-alist' and `macro-declarations-alist'.
For more information, see info node `(elisp)Declare Form'."
- ;; FIXME: edebug spec should pay attention to defun-declarations-alist.
- nil)
+ ;; `declare' is handled directly by `defun/defmacro' rather than here.
+ ;; If we get here, it's because there's a `declare' somewhere not attached
+ ;; to a `defun/defmacro', i.e. a `declare' which doesn't do what it's
+ ;; intended to do.
+ (let ((form `(declare . ,specs))) ;; FIXME: WIBNI we had &whole?
+ (macroexp-warn-and-return
+ (format-message "Stray `declare' form: %S" form)
+ ;; Make a "unique" harmless form to circumvent
+ ;; the cache in `macroexp-warn-and-return'.
+ `(progn ',form nil) nil 'compile-only)))
(defmacro ignore-errors (&rest body)
"Execute BODY; if an error occurs, return nil.
@@ -1209,7 +1219,7 @@ Subkeymaps may be modified but are not canonicalized."
(defun keyboard-translate (from to)
"Translate character FROM to TO on the current terminal.
-This is a legacy function; see `keymap-translate' for the
+This is a legacy function; see `key-translate' for the
recommended function to use instead.
This function creates a `keyboard-translate-table' if necessary
@@ -1288,7 +1298,7 @@ KEY is a string or vector representing a sequence of
keystrokes."
(defun local-key-binding (keys &optional accept-default)
"Return the binding for command KEYS in current local keymap only.
-This is a legacy function; see `keymap-local-binding' for the
+This is a legacy function; see `keymap-local-lookup' for the
recommended function to use instead.
KEYS is a string or vector, a sequence of keystrokes.
@@ -1302,7 +1312,7 @@ about this."
(defun global-key-binding (keys &optional accept-default)
"Return the binding for command KEYS in current global keymap only.
-This is a legacy function; see `keymap-global-binding' for the
+This is a legacy function; see `keymap-global-lookup' for the
recommended function to use instead.
KEYS is a string or vector, a sequence of keystrokes.
@@ -1837,7 +1847,12 @@ be a list of the form returned by `event-start' and
`event-end'."
(set-advertised-calling-convention 'time-convert '(time form) "29.1")
;;;; Obsolescence declarations for variables, and aliases.
-
+(make-obsolete-variable
+ 'inhibit-point-motion-hooks
+ "use `cursor-intangible-mode' or `cursor-sensor-mode' instead"
+ ;; It's been announced as obsolete in NEWS and in the docstring since
Emacs-25,
+ ;; but it's only been marked for compilation warnings since Emacs-29.
+ "25.1")
(make-obsolete-variable 'redisplay-dont-pause nil "24.5")
(make-obsolete-variable 'operating-system-release nil "28.1")
(make-obsolete-variable 'inhibit-changing-match-data 'save-match-data "29.1")
@@ -2569,7 +2584,7 @@ Uses the `derived-mode-parent' property of the symbol to
trace backwards."
(defun major-mode-restore (&optional avoided-modes)
"Restore major mode earlier suspended with `major-mode-suspend'.
If there was no earlier suspended major mode, then fallback to `normal-mode',
-tho trying to avoid AVOIDED-MODES."
+though trying to avoid AVOIDED-MODES."
(if major-mode--suspended
(funcall (prog1 major-mode--suspended
(kill-local-variable 'major-mode--suspended)))
@@ -3257,7 +3272,14 @@ An obsolete, but still supported form is
where the optional arg MILLISECONDS specifies an additional wait period,
in milliseconds; this was useful when Emacs was built without
floating point support."
- (declare (advertised-calling-convention (seconds &optional nodisp) "22.1"))
+ (declare (advertised-calling-convention (seconds &optional nodisp) "22.1")
+ (compiler-macro
+ (lambda (form)
+ (if (not (or (numberp nodisp) obsolete)) form
+ (macroexp-warn-and-return
+ "Obsolete calling convention for 'sit-for'"
+ `(,(car form) (+ ,seconds (/ (or ,nodisp 0) 1000.0))
,obsolete)
+ '(obsolete sit-for))))))
;; This used to be implemented in C until the following discussion:
;; https://lists.gnu.org/r/emacs-devel/2006-07/msg00401.html
;; Then it was moved here using an implementation based on an idle timer,
@@ -6889,7 +6911,7 @@ string will be displayed only if BODY takes longer than
TIMEOUT seconds.
If FUNC is a function alias, return the function alias chain.
If the function alias chain contains loops, an error will be
-signalled. If NOERROR, the non-loop parts of the chain is returned."
+signaled. If NOERROR, the non-loop parts of the chain is returned."
(declare (side-effect-free t))
(let ((chain nil)
(orig-func func))
@@ -7039,7 +7061,7 @@ CONDITION is either:
(defun match-buffers (condition &optional buffers arg)
"Return a list of buffers that match CONDITION.
-See `buffer-match' for details on CONDITION. By default all
+See `buffer-match-p' for details on CONDITION. By default all
buffers are checked, this can be restricted by passing an
optional argument BUFFERS, set to a list of buffers to check.
ARG is passed to `buffer-match', for predicate conditions in
diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el
index abefd996a8..eb4cec4861 100644
--- a/lisp/tab-bar.el
+++ b/lisp/tab-bar.el
@@ -33,7 +33,8 @@
(eval-when-compile
(require 'cl-lib)
- (require 'seq))
+ (require 'seq)
+ (require 'icons))
(defgroup tab-bar nil
@@ -155,25 +156,43 @@ For easier selection of tabs by their numbers, consider
customizing
(defun tab-bar--load-buttons ()
"Load the icons for the tab buttons."
- (when (and tab-bar-new-button
- (not (get-text-property 0 'display tab-bar-new-button)))
- ;; This file is pre-loaded so only here we can use the right
data-directory:
- (add-text-properties 0 (length tab-bar-new-button)
- `(display (image :type xpm
- :file "tabs/new.xpm"
- :margin ,tab-bar-button-margin
- :ascent center))
- tab-bar-new-button))
-
- (when (and tab-bar-close-button
- (not (get-text-property 0 'display tab-bar-close-button)))
- ;; This file is pre-loaded so only here we can use the right
data-directory:
- (add-text-properties 0 (length tab-bar-close-button)
- `(display (image :type xpm
- :file "tabs/close.xpm"
- :margin ,tab-bar-button-margin
- :ascent center))
- tab-bar-close-button)))
+ (require 'icons)
+ (unless (iconp 'tab-bar-new)
+ (define-icon tab-bar-new nil
+ `((image "tabs/new.xpm"
+ :margin ,tab-bar-button-margin
+ :ascent center)
+ ;; (emoji "➕")
+ ;; (symbol "＋")
+ (text " + "))
+ "Icon for creating a new tab."
+ :version "29.1"
+ :help-echo "New tab"))
+ (setq tab-bar-new-button (icon-string 'tab-bar-new))
+
+ (unless (iconp 'tab-bar-close)
+ (define-icon tab-bar-close nil
+ `((image "tabs/close.xpm"
+ :margin ,tab-bar-button-margin
+ :ascent center)
+ ;; (emoji " ❌")
+ ;; (symbol "✕") ;; "ⓧ"
+ (text " x"))
+ "Icon for closing the clicked tab."
+ :version "29.1"
+ :help-echo "Click to close tab"))
+ (setq tab-bar-close-button (propertize (icon-string 'tab-bar-close)
+ 'close-tab t))
+
+ (unless (iconp 'tab-bar-menu-bar)
+ (define-icon tab-bar-menu-bar nil
+ '(;; (emoji "🍔")
+ (symbol "☰")
+ (text "Menu" :face tab-bar-tab-inactive))
+ "Icon for for the menu bar."
+ :version "29.1"
+ :help-echo "Menu bar"))
+ (setq tab-bar-menu-bar-button (icon-string 'tab-bar-menu-bar)))
(defun tab-bar--tab-bar-lines-for-frame (frame)
"Determine and return the value of `tab-bar-lines' for FRAME.
@@ -721,7 +740,7 @@ If a function returns nil, it doesn't directly affect the
tab bar appearance, but can do that by some side-effect.
If the list ends with `tab-bar-format-align-right' and
`tab-bar-format-global', then after enabling `display-time-mode'
-(or any other mode that uses `global-mode-string'),
+\(or any other mode that uses `global-mode-string'),
it will display time aligned to the right on the tab bar instead
of the mode line. Replacing `tab-bar-format-tabs' with
`tab-bar-format-tabs-groups' will group tabs on the tab bar."
@@ -914,14 +933,16 @@ when the tab is current. Return the result as a keymap."
(let* ((rest (cdr (memq 'tab-bar-format-align-right tab-bar-format)))
(rest (tab-bar-format-list rest))
(rest (mapconcat (lambda (item) (nth 2 item)) rest ""))
- (hpos (string-pixel-width (propertize rest 'face 'tab-bar)))
+ (hpos (progn
+ (add-face-text-property 0 (length rest) 'tab-bar t rest)
+ (string-pixel-width rest)))
(str (propertize " " 'display `(space :align-to (- right (,hpos))))))
`((align-right menu-item ,str ignore))))
(defun tab-bar-format-global ()
"Produce display of `global-mode-string' in the tab bar.
When `tab-bar-format-global' is added to `tab-bar-format'
-(possibly appended after `tab-bar-format-align-right'),
+\(possibly appended after `tab-bar-format-align-right'),
then modes that display information on the mode line
using `global-mode-string' will display the same text
on the tab bar instead."
@@ -944,7 +965,146 @@ on the tab bar instead."
(defun tab-bar-make-keymap-1 ()
"Generate an actual keymap from `tab-bar-map', without caching."
- (append tab-bar-map (tab-bar-format-list tab-bar-format)))
+ (let ((items (tab-bar-format-list tab-bar-format)))
+ (when tab-bar-auto-width
+ (setq items (tab-bar-auto-width items)))
+ (append tab-bar-map items)))
+
+
+(defcustom tab-bar-auto-width t
+ "Automatically resize width of tabs on tab bar to fill available tab-bar
space.
+When non-nil, the widths of the tabs on the tab bar are
+automatically resized so that their width is evenly distributed
+across the tab bar. This keeps the widths of the tabs
+independent of the length of the buffer names shown on each tab;
+the tab widths change only when tabs are added or deleted, or
+when the frame's dimensions change. This also avoids as much as
+possible wrapping a long tab bar to a second tab-bar line.
+
+The automatic resizing of tabs takes place as long as tabs are no
+wider than allowed by the value of `tab-bar-auto-width-max', and
+at least as wide as specified by the value of
+`tab-bar-auto-width-min'.
+
+When this variable is nil, the width of each tab is determined by the
+length of the tab's name."
+ :type 'boolean
+ :group 'tab-bar
+ :version "29.1")
+
+(defcustom tab-bar-auto-width-max '(220 20)
+ "Maximum width for automatic resizing of width of tab-bar tabs.
+This determines the maximum width of tabs before their names will be
+truncated on display.
+The value should be a list of two numbers: the first is the maximum
+width of tabs in pixels for GUI frames, the second is the maximum
+width of tabs in characters on TTY frames.
+If the value of this variable is nil, there is no limit on maximum
+width.
+This variable has effect only when `tab-bar-auto-width' is non-nil."
+ :type '(choice
+ (const :tag "No limit" nil)
+ (list (integer :tag "Max width (pixels)" :value 220)
+ (integer :tag "Max width (chars)" :value 20)))
+ :initialize 'custom-initialize-default
+ :set (lambda (sym val)
+ (set-default sym val)
+ (setq tab-bar--fixed-width-hash nil))
+ :group 'tab-bar
+ :version "29.1")
+
+(defvar tab-bar-auto-width-min '(20 2)
+ "Minimum width of tabs for automatic resizing under `tab-bar-auto-width'.
+The value should be a list of two numbers, giving the minimum width
+as the number of pixels for GUI frames and the number of characters
+for text-mode frames. Tabs whose width is smaller than this will not
+be narrowed.
+It's not recommended to change this value since with larger values, the
+tab bar might wrap to the second line when it shouldn't.")
+
+(defvar tab-bar-auto-width-faces
+ '( tab-bar-tab tab-bar-tab-inactive
+ tab-bar-tab-ungrouped
+ tab-bar-tab-group-inactive)
+ "Resize tabs only with these faces.")
+
+(defvar tab-bar--fixed-width-hash nil
+ "Memoization table for `tab-bar-auto-width'.")
+
+(defun tab-bar-auto-width (items)
+ "Return tab-bar items with resized tab names."
+ (unless tab-bar--fixed-width-hash
+ (define-hash-table-test 'tab-bar--fixed-width-hash-test
+ #'equal-including-properties
+ #'sxhash-equal-including-properties)
+ (setq tab-bar--fixed-width-hash
+ (make-hash-table :test 'tab-bar--fixed-width-hash-test)))
+ (let ((tabs nil) ;; list of resizable tabs
+ (non-tabs "") ;; concatenated names of non-resizable tabs
+ (width 0)) ;; resize tab names to this width
+ (dolist (item items)
+ (when (and (eq (nth 1 item) 'menu-item) (stringp (nth 2 item)))
+ (if (memq (get-text-property 0 'face (nth 2 item))
+ tab-bar-auto-width-faces)
+ (push item tabs)
+ (unless (eq (nth 0 item) 'align-right)
+ (setq non-tabs (concat non-tabs (nth 2 item)))))))
+ (when tabs
+ (add-face-text-property 0 (length non-tabs) 'tab-bar t non-tabs)
+ (setq width (/ (- (frame-inner-width)
+ (string-pixel-width non-tabs))
+ (length tabs)))
+ (when tab-bar-auto-width-min
+ (setq width (max width (if window-system
+ (nth 0 tab-bar-auto-width-min)
+ (nth 1 tab-bar-auto-width-min)))))
+ (when tab-bar-auto-width-max
+ (setq width (min width (if window-system
+ (nth 0 tab-bar-auto-width-max)
+ (nth 1 tab-bar-auto-width-max)))))
+ (dolist (item tabs)
+ (setf (nth 2 item)
+ (with-memoization (gethash (list (selected-frame)
+ width (nth 2 item))
+ tab-bar--fixed-width-hash)
+ (let* ((name (nth 2 item))
+ (len (length name))
+ (close-p (get-text-property (1- len) 'close-tab name))
+ (continue t)
+ (prev-width (string-pixel-width name))
+ curr-width)
+ (cond
+ ((< prev-width width)
+ (let* ((space (apply 'propertize " "
+ (text-properties-at 0 name)))
+ (ins-pos (- len (if close-p 1 0)))
+ (prev-name name))
+ (while continue
+ (setf (substring name ins-pos ins-pos) space)
+ (setq curr-width (string-pixel-width name))
+ (if (and (< curr-width width)
+ (not (eq curr-width prev-width)))
+ (setq prev-width curr-width
+ prev-name name)
+ ;; Set back a shorter name
+ (setq name prev-name
+ continue nil)))))
+ ((> prev-width width)
+ (let ((del-pos1 (if close-p -2 -1))
+ (del-pos2 (if close-p -1 nil)))
+ (while continue
+ (setf (substring name del-pos1 del-pos2) "")
+ (setq curr-width (string-pixel-width name))
+ (if (and (> curr-width width)
+ (not (eq curr-width prev-width)))
+ (setq prev-width curr-width)
+ (setq continue nil)))
+ (let* ((len (length name))
+ (pos (- len (if close-p 1 0))))
+ (add-face-text-property
+ (max 0 (- pos 2)) (max 0 pos) 'shadow nil name)))))
+ name)))))
+ items))
;; Some window-configuration parameters don't need to be persistent.
@@ -1091,7 +1251,8 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
(to-number (cond ((< tab-number 0) (+ (length tabs) (1+ tab-number)))
((zerop tab-number) (1+ from-index))
(t tab-number)))
- (to-index (1- (max 1 (min to-number (length tabs))))))
+ (to-index (1- (max 1 (min to-number (length tabs)))))
+ (minibuffer-was-active (minibuffer-window-active-p
(selected-window))))
(unless (eq from-index to-index)
(let* ((from-tab (tab-bar--tab))
@@ -1117,7 +1278,7 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
(wc-history-back (alist-get 'wc-history-back to-tab))
(wc-history-forward (alist-get 'wc-history-forward to-tab)))
- (set-window-configuration wc)
+ (set-window-configuration wc nil t)
;; set-window-configuration does not restore the value of
;; point in the current buffer, so restore it separately.
@@ -1145,8 +1306,22 @@ Negative TAB-NUMBER counts tabs from the end of the tab
bar."
tab-bar-history-forward))))
(ws
+ ;; `window-state-put' fails when called in the minibuffer
+ (when (minibuffer-selected-window)
+ (select-window (minibuffer-selected-window)))
(window-state-put ws nil 'safe)))
+ ;; Select the minibuffer when it was active before switching tabs
+ (when (and minibuffer-was-active (active-minibuffer-window))
+ (select-window (active-minibuffer-window)))
+
+ ;; When the minibuffer was activated in one tab, but exited in
+ ;; another tab, then after going back to the first tab, it has
+ ;; such inconsistent state that the current buffer is the minibuffer,
+ ;; but its window is not active. So try to undo this mess.
+ (when (and (minibufferp) (not (active-minibuffer-window)))
+ (other-window 1))
+
(when tab-bar-history-mode
(setq tab-bar-history-omit t))
@@ -1881,7 +2056,7 @@ This navigates back in the history of window
configurations."
(cons tab-bar-history-old
(gethash (selected-frame) tab-bar-history-forward))
tab-bar-history-forward)
- (set-window-configuration wc)
+ (set-window-configuration wc nil t)
(when (and (markerp wc-point) (marker-buffer wc-point))
(goto-char wc-point)))
(message "No more tab back history"))))
@@ -1900,7 +2075,7 @@ This navigates forward in the history of window
configurations."
(cons tab-bar-history-old
(gethash (selected-frame) tab-bar-history-back))
tab-bar-history-back)
- (set-window-configuration wc)
+ (set-window-configuration wc nil t)
(when (and (markerp wc-point) (marker-buffer wc-point))
(goto-char wc-point)))
(message "No more tab forward history"))))
@@ -1916,22 +2091,27 @@ and can restore them."
:global t :group 'tab-bar
(if tab-bar-history-mode
(progn
- (when (and tab-bar-mode (not (get-text-property 0 'display
tab-bar-back-button)))
- ;; This file is pre-loaded so only here we can use the right
data-directory:
- (add-text-properties 0 (length tab-bar-back-button)
- `(display (image :type xpm
- :file "tabs/left-arrow.xpm"
- :margin ,tab-bar-button-margin
- :ascent center))
- tab-bar-back-button))
- (when (and tab-bar-mode (not (get-text-property 0 'display
tab-bar-forward-button)))
- ;; This file is pre-loaded so only here we can use the right
data-directory:
- (add-text-properties 0 (length tab-bar-forward-button)
- `(display (image :type xpm
- :file "tabs/right-arrow.xpm"
- :margin ,tab-bar-button-margin
- :ascent center))
- tab-bar-forward-button))
+ (require 'icons)
+
+ (unless (iconp 'tab-bar-back)
+ (define-icon tab-bar-back nil
+ `((image "tabs/left-arrow.xpm"
+ :margin ,tab-bar-button-margin
+ :ascent center)
+ (text " < "))
+ "Icon for going back in tab history."
+ :version "29.1"))
+ (setq tab-bar-back-button (icon-string 'tab-bar-back))
+
+ (unless (iconp 'tab-bar-forward)
+ (define-icon tab-bar-forward nil
+ `((image "tabs/right-arrow.xpm"
+ :margin ,tab-bar-button-margin
+ :ascent center)
+ (text " > "))
+ "Icon for going forward in tab history."
+ :version "29.1"))
+ (setq tab-bar-forward-button (icon-string 'tab-bar-forward))
(add-hook 'pre-command-hook 'tab-bar--history-pre-change)
(add-hook 'window-configuration-change-hook 'tab-bar--history-change))
@@ -2168,7 +2348,7 @@ with those specified by the selected window
configuration."
((framep all-frames) (list all-frames))
(t (list (selected-frame)))))
-(defun tab-bar-get-buffer-tab (buffer-or-name &optional all-frames
ignore-current-tab)
+(defun tab-bar-get-buffer-tab (buffer-or-name &optional all-frames
ignore-current-tab all-tabs)
"Return the tab that owns the window whose buffer is BUFFER-OR-NAME.
BUFFER-OR-NAME may be a buffer or a buffer name, and defaults to
the current buffer.
@@ -2186,14 +2366,20 @@ selected frame and no others.
When the optional argument IGNORE-CURRENT-TAB is non-nil,
don't take into account the buffers in the currently selected tab.
-Otherwise, prefer buffers of the current tab."
+Otherwise, prefer buffers of the current tab.
+
+When the optional argument ALL-TABS is non-nil, return a list of all tabs
+that contain the buffer BUFFER-OR-NAME."
(let ((buffer (if buffer-or-name
(get-buffer buffer-or-name)
- (current-buffer))))
+ (current-buffer)))
+ buffer-tabs)
(when (bufferp buffer)
- (seq-some
+ (funcall
+ (if all-tabs #'seq-each #'seq-some)
(lambda (frame)
- (seq-some
+ (funcall
+ (if all-tabs #'seq-each #'seq-some)
(lambda (tab)
(when (if (eq (car tab) 'current-tab)
(get-buffer-window buffer frame)
@@ -2205,8 +2391,9 @@ Otherwise, prefer buffers of the current tab."
(memq buffer buffers)
;; writable window-state
(member (buffer-name buffer) buffers))))
- (append tab `((index . ,(tab-bar--tab-index tab nil frame))
- (frame . ,frame)))))
+ (push (append tab `((index . ,(tab-bar--tab-index tab nil frame))
+ (frame . ,frame)))
+ buffer-tabs)))
(let* ((tabs (funcall tab-bar-tabs-function frame))
(current-tab (tab-bar--current-tab-find tabs)))
(setq tabs (remq current-tab tabs))
@@ -2215,7 +2402,8 @@ Otherwise, prefer buffers of the current tab."
tabs
;; Make sure current-tab is at the beginning of tabs.
(cons current-tab tabs)))))
- (tab-bar--reusable-frames all-frames)))))
+ (tab-bar--reusable-frames all-frames))
+ (if all-tabs (nreverse buffer-tabs) (car (last buffer-tabs))))))
(defun display-buffer-in-tab (buffer alist)
"Display BUFFER in a tab using display actions in ALIST.
diff --git a/lisp/tab-line.el b/lisp/tab-line.el
index 94e8f29a95..99a785ee3e 100644
--- a/lisp/tab-line.el
+++ b/lisp/tab-line.el
@@ -483,7 +483,7 @@ which the tab will represent."
(dolist (fn tab-line-tab-face-functions)
(setf face (funcall fn tab tabs face buffer-p selected-p)))
(apply 'propertize
- (concat (propertize name
+ (concat (propertize (string-replace "%" "%%" name) ;; (bug#57848)
'keymap tab-line-tab-map
'help-echo (if selected-p "Current tab"
"Click to select tab")
@@ -572,19 +572,31 @@ For use in `tab-line-tab-face-functions'."
(defvar tab-line-auto-hscroll)
+(defun tab-line-cache-key-default (_tabs)
+ "Return default list of cache keys."
+ (list
+ ;; for setting face 'tab-line-tab-current'
+ (mode-line-window-selected-p)
+ ;; for `tab-line-tab-face-modified'
+ (and (memq 'tab-line-tab-face-modified
+ tab-line-tab-face-functions)
+ (buffer-file-name)
+ (buffer-modified-p))))
+
+(defvar tab-line-cache-key-function #'tab-line-cache-key-default
+ "Function that adds more cache keys.
+It is called with one argument, a list of tabs, and should return a list
+of cache keys. You can use `add-function' to add more cache keys.")
+
(defun tab-line-format ()
"Format for displaying the tab line of the selected window."
(let* ((tabs (funcall tab-line-tabs-function))
- (cache-key (list tabs
- ;; handle buffer renames
- (buffer-name (window-buffer))
- ;; handle tab-line scrolling
- (window-parameter nil 'tab-line-hscroll)
- ;; for setting face 'tab-line-tab-current'
- (mode-line-window-selected-p)
- (and (memq 'tab-line-tab-face-modified
- tab-line-tab-face-functions)
- (buffer-file-name) (buffer-modified-p))))
+ (cache-key (append (list tabs
+ ;; handle buffer renames
+ (buffer-name (window-buffer))
+ ;; handle tab-line scrolling
+ (window-parameter nil 'tab-line-hscroll))
+ (funcall tab-line-cache-key-function tabs)))
(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.
@@ -620,7 +632,8 @@ the selected tab visible."
(let ((truncate-partial-width-windows nil)
(inhibit-modification-hooks t)
show-arrows)
- (setq truncate-lines nil)
+ (setq truncate-lines nil
+ word-wrap nil)
(erase-buffer)
(apply 'insert strings)
(goto-char (point-min))
diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el
index 20f1573916..a398bb9fb2 100644
--- a/lisp/term/pgtk-win.el
+++ b/lisp/term/pgtk-win.el
@@ -184,7 +184,7 @@ DISPLAY is the name of the display Emacs should connect to."
(defun pgtk-preedit-text (event)
"An internal function to display preedit text from input method.
-EVENT is a `preedit-text-event'."
+EVENT is a `preedit-text' event."
(interactive "e")
(when pgtk-preedit-overlay
(delete-overlay pgtk-preedit-overlay))
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 8135d40d26..f4b557f443 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1,7 +1,6 @@
;;; bibtex.el --- BibTeX mode for GNU Emacs -*- lexical-binding: t -*-
-;; Copyright (C) 1992, 1994-1999, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1992-2022 Free Software Foundation, Inc.
;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de>
;; Bengt Martensson <bengt@mathematik.uni-Bremen.de>
@@ -29,14 +28,13 @@
;;; Commentary:
-;; Major mode for editing and validating BibTeX files.
+;; Major mode for editing and validating BibTeX files.
-;; Usage:
-;; See documentation for `bibtex-mode' or type "M-x describe-mode"
-;; when you are in BibTeX mode.
+;; See documentation for `bibtex-mode' or type `M-x describe-mode'
+;; when you are in BibTeX mode.
-;; Todo:
-;; Distribute texinfo file.
+;; Todo:
+;; Distribute texinfo file.
;;; Code:
@@ -1548,65 +1546,65 @@ Set this variable before loading BibTeX mode."
st)
"Syntax table used in BibTeX mode buffers.")
-(defvar bibtex-mode-map
- (let ((km (make-sparse-keymap)))
- ;; The Key `C-c&' is reserved for reftex.el
- (define-key km "\t" 'bibtex-find-text)
- (define-key km "\n" 'bibtex-next-field)
- (define-key km [remap forward-paragraph] 'bibtex-next-entry)
- (define-key km [remap backward-paragraph] 'bibtex-previous-entry)
- (define-key km "\M-\t" 'completion-at-point)
- (define-key km "\C-c\"" 'bibtex-remove-delimiters)
- (define-key km "\C-c{" 'bibtex-remove-delimiters)
- (define-key km "\C-c}" 'bibtex-remove-delimiters)
- (define-key km "\C-c\C-c" 'bibtex-clean-entry)
- (define-key km "\C-c\C-q" 'bibtex-fill-entry)
- (define-key km "\C-c\C-s" 'bibtex-search-entry)
- (define-key km "\C-c\C-x" 'bibtex-search-crossref)
- (define-key km "\C-c\C-t" 'bibtex-copy-summary-as-kill)
- (define-key km "\C-c?" 'bibtex-print-help-message)
- (define-key km "\C-c\C-p" 'bibtex-pop-previous)
- (define-key km "\C-c\C-n" 'bibtex-pop-next)
- (define-key km "\C-c\C-k" 'bibtex-kill-field)
- (define-key km "\C-c\M-k" 'bibtex-copy-field-as-kill)
- (define-key km "\C-c\C-w" 'bibtex-kill-entry)
- (define-key km "\C-c\M-w" 'bibtex-copy-entry-as-kill)
- (define-key km "\C-c\C-y" 'bibtex-yank)
- (define-key km "\C-c\M-y" 'bibtex-yank-pop)
- (define-key km "\C-c\C-d" 'bibtex-empty-field)
- (define-key km "\C-c\C-f" 'bibtex-make-field)
- (define-key km "\C-c\C-u" 'bibtex-entry-update)
- (define-key km "\C-c$" 'bibtex-ispell-abstract)
- (define-key km "\M-\C-a" 'bibtex-beginning-of-entry)
- (define-key km "\M-\C-e" 'bibtex-end-of-entry)
- (define-key km "\C-\M-l" 'bibtex-reposition-window)
- (define-key km "\C-\M-h" 'bibtex-mark-entry)
- (define-key km "\C-c\C-b" 'bibtex-entry)
- (define-key km "\C-c\C-rn" 'bibtex-narrow-to-entry)
- (define-key km "\C-c\C-rw" 'widen)
- (define-key km "\C-c\C-l" 'bibtex-url)
- (define-key km "\C-c\C-a" 'bibtex-search-entries)
- (define-key km "\C-c\C-o" 'bibtex-remove-OPT-or-ALT)
- (define-key km "\C-c\C-e\C-i" 'bibtex-InProceedings)
- (define-key km "\C-c\C-ei" 'bibtex-InCollection)
- (define-key km "\C-c\C-eI" 'bibtex-InBook)
- (define-key km "\C-c\C-e\C-a" 'bibtex-Article)
- (define-key km "\C-c\C-e\C-b" 'bibtex-InBook)
- (define-key km "\C-c\C-eb" 'bibtex-Book)
- (define-key km "\C-c\C-eB" 'bibtex-Booklet)
- (define-key km "\C-c\C-e\C-c" 'bibtex-InCollection)
- (define-key km "\C-c\C-e\C-m" 'bibtex-Manual)
- (define-key km "\C-c\C-em" 'bibtex-MastersThesis)
- (define-key km "\C-c\C-eM" 'bibtex-Misc)
- (define-key km "\C-c\C-e\C-p" 'bibtex-InProceedings)
- (define-key km "\C-c\C-ep" 'bibtex-Proceedings)
- (define-key km "\C-c\C-eP" 'bibtex-PhdThesis)
- (define-key km "\C-c\C-e\M-p" 'bibtex-Preamble)
- (define-key km "\C-c\C-e\C-s" 'bibtex-String)
- (define-key km "\C-c\C-e\C-t" 'bibtex-TechReport)
- (define-key km "\C-c\C-e\C-u" 'bibtex-Unpublished)
- km)
- "Keymap used in BibTeX mode.")
+(defvar-keymap bibtex-mode-map
+ :doc "Keymap used in BibTeX mode."
+ ;; The Key `C-c &' is reserved for reftex.el
+ "TAB" #'bibtex-find-text
+ "C-j" #'bibtex-next-field
+ "M-TAB" #'completion-at-point
+ "C-c \"" #'bibtex-remove-delimiters
+ "C-c {" #'bibtex-remove-delimiters
+ "C-c }" #'bibtex-remove-delimiters
+ "C-c C-c" #'bibtex-clean-entry
+ "C-c C-q" #'bibtex-fill-entry
+ "C-c C-s" #'bibtex-search-entry
+ "C-c C-x" #'bibtex-search-crossref
+ "C-c C-t" #'bibtex-copy-summary-as-kill
+ "C-c ?" #'bibtex-print-help-message
+ "C-c C-p" #'bibtex-pop-previous
+ "C-c C-n" #'bibtex-pop-next
+ "C-c C-k" #'bibtex-kill-field
+ "C-c M-k" #'bibtex-copy-field-as-kill
+ "C-c C-w" #'bibtex-kill-entry
+ "C-c M-w" #'bibtex-copy-entry-as-kill
+ "C-c C-y" #'bibtex-yank
+ "C-c M-y" #'bibtex-yank-pop
+ "C-c C-d" #'bibtex-empty-field
+ "C-c C-f" #'bibtex-make-field
+ "C-c C-u" #'bibtex-entry-update
+ "C-c $" #'bibtex-ispell-abstract
+ "C-M-a" #'bibtex-beginning-of-entry
+ "C-M-e" #'bibtex-end-of-entry
+ "C-M-l" #'bibtex-reposition-window
+ "C-M-h" #'bibtex-mark-entry
+ "C-c C-b" #'bibtex-entry
+ "C-c C-r n" #'bibtex-narrow-to-entry
+ "C-c C-r w" #'widen
+ "C-c C-l" #'bibtex-url
+ "C-c C-a" #'bibtex-search-entries
+ "C-c C-o" #'bibtex-remove-OPT-or-ALT
+ ;; Most below functions seem to be undefined, which makes the
+ ;; byte-compiler warn if we quote them with #'.
+ "C-c C-e TAB" 'bibtex-InProceedings
+ "C-c C-e i" 'bibtex-InCollection
+ "C-c C-e I" 'bibtex-InBook
+ "C-c C-e C-a" 'bibtex-Article
+ "C-c C-e C-b" 'bibtex-InBook
+ "C-c C-e b" 'bibtex-Book
+ "C-c C-e B" 'bibtex-Booklet
+ "C-c C-e C-c" 'bibtex-InCollection
+ "C-c C-e RET" 'bibtex-Manual
+ "C-c C-e m" 'bibtex-MastersThesis
+ "C-c C-e M" 'bibtex-Misc
+ "C-c C-e C-p" 'bibtex-InProceedings
+ "C-c C-e p" 'bibtex-Proceedings
+ "C-c C-e P" 'bibtex-PhdThesis
+ "C-c C-e M-p" #'bibtex-Preamble
+ "C-c C-e C-s" #'bibtex-String
+ "C-c C-e C-t" 'bibtex-TechReport
+ "C-c C-e C-u" 'bibtex-Unpublished
+ "<remap> <forward-paragraph>" #'bibtex-next-entry
+ "<remap> <backward-paragraph>" #'bibtex-previous-entry)
(easy-menu-define bibtex-edit-menu bibtex-mode-map
"BibTeX-Edit Menu in BibTeX mode."
diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el
index 097d4f8241..4b46e5a1fb 100644
--- a/lisp/textmodes/css-mode.el
+++ b/lisp/textmodes/css-mode.el
@@ -884,26 +884,24 @@ cannot be completed sensibly: `custom-ident',
(modify-syntax-entry ?? "." st)
st))
-(defvar css-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [remap info-lookup-symbol] 'css-lookup-symbol)
- ;; `info-complete-symbol' is not used.
- (define-key map [remap complete-symbol] 'completion-at-point)
- (define-key map "\C-c\C-f" 'css-cycle-color-format)
- (easy-menu-define css-menu map "CSS mode menu"
- '("CSS"
- :help "CSS-specific features"
- ["Reformat block" fill-paragraph
- :help "Reformat declaration block or fill comment at point"]
- ["Cycle color format" css-cycle-color-format
- :help "Cycle color at point between different formats"]
- "-"
- ["Describe symbol" css-lookup-symbol
- :help "Display documentation for a CSS symbol"]
- ["Complete symbol" completion-at-point
- :help "Complete symbol before point"]))
- map)
- "Keymap used in `css-mode'.")
+(defvar-keymap css-mode-map
+ :doc "Keymap used in `css-mode'."
+ "<remap> <info-lookup-symbol>" #'css-lookup-symbol
+ ;; `info-complete-symbol' is not used.
+ "<remap> <complete-symbol>" #'completion-at-point
+ "C-c C-f" #'css-cycle-color-format
+ :menu
+ '("CSS"
+ :help "CSS-specific features"
+ ["Reformat block" fill-paragraph
+ :help "Reformat declaration block or fill comment at point"]
+ ["Cycle color format" css-cycle-color-format
+ :help "Cycle color at point between different formats"]
+ "-"
+ ["Describe symbol" css-lookup-symbol
+ :help "Display documentation for a CSS symbol"]
+ ["Complete symbol" completion-at-point
+ :help "Complete symbol before point"]))
(eval-and-compile
(defconst css--uri-re
diff --git a/lisp/textmodes/emacs-news-mode.el
b/lisp/textmodes/emacs-news-mode.el
index d9decae4df..ebb31da9cf 100644
--- a/lisp/textmodes/emacs-news-mode.el
+++ b/lisp/textmodes/emacs-news-mode.el
@@ -73,12 +73,9 @@
(defun emacs-news--mode-common ()
(setq-local font-lock-defaults '(emacs-news-mode-font-lock-keywords t))
- ;; This `outline-regexp' matches leading spaces inserted
- ;; by the current implementation of `outline-minor-mode-use-buttons'.
- (setq-local outline-regexp "\\(?: +\\)?\\(\\*+\\) "
- outline-level (lambda () (length (match-string 1)))
- outline-minor-mode-cycle t
- outline-minor-mode-highlight 'append)
+ (setq-local outline-minor-mode-cycle t
+ outline-minor-mode-highlight 'append
+ outline-minor-mode-use-buttons 'in-margins)
(outline-minor-mode)
(setq-local imenu-generic-expression outline-imenu-generic-expression)
(emacs-etc--hide-local-variables))
diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el
index 935be06812..26f22a9a4a 100644
--- a/lisp/textmodes/enriched.el
+++ b/lisp/textmodes/enriched.el
@@ -325,8 +325,7 @@ the region, and the START and END of each region."
;;;###autoload
(defun enriched-encode (from to orig-buf)
(if enriched-verbose (message "Enriched: encoding document..."))
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t))
+ (let ((inhibit-read-only t))
(save-restriction
(narrow-to-region from to)
(delete-to-left-margin)
diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el
index 774e7ac737..11039f2963 100644
--- a/lisp/textmodes/flyspell.el
+++ b/lisp/textmodes/flyspell.el
@@ -1032,7 +1032,6 @@ Mostly we check word delimiters."
(defun flyspell-word-search-backward (word bound &optional ignore-case)
(save-excursion
(let* ((r '())
- (inhibit-point-motion-hooks t)
(flyspell-not-casechars (flyspell-get-not-casechars))
(bound (if (and bound
(> bound (point-min)))
@@ -1066,7 +1065,6 @@ Mostly we check word delimiters."
(defun flyspell-word-search-forward (word bound)
(save-excursion
(let* ((r '())
- (inhibit-point-motion-hooks t)
(flyspell-not-casechars (flyspell-get-not-casechars))
(bound (if (and bound
(< bound (point-max)))
@@ -2133,7 +2131,9 @@ But don't look beyond what's visible on the screen."
;; only reset if a new overlay exists
(setq flyspell-auto-correct-previous-pos nil)
- (let ((overlay-list (overlays-in (point-min) position))
+ (let ((overlay-list (seq-sort-by
+ #'overlay-start #'>
+ (overlays-in (point-min) position)))
(new-overlay 'dummy-value))
;; search for previous (new) flyspell overlay
diff --git a/lisp/textmodes/less-css-mode.el b/lisp/textmodes/less-css-mode.el
index 5d17b390f4..bfb5566e89 100644
--- a/lisp/textmodes/less-css-mode.el
+++ b/lisp/textmodes/less-css-mode.el
@@ -24,7 +24,7 @@
;;; Commentary:
;; This mode provides syntax highlighting for Less CSS files
-;; (http://lesscss.org/), plus optional support for compilation of
+;; (https://lesscss.org/), plus optional support for compilation of
;; .less files to .css files at the time they are saved: use
;; `less-css-compile-at-save' to enable this.
;;
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
index 05c02308e5..b133b1e9e3 100644
--- a/lisp/textmodes/page-ext.el
+++ b/lisp/textmodes/page-ext.el
@@ -276,19 +276,17 @@ Used by `pages-directory-for-addresses' function."
;;; Key bindings for page handling functions
-(defvar pages--ctl-x-ctl-p-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-n" #'pages-next-page)
- (define-key map "\C-p" #'pages-previous-page)
- (define-key map "\C-a" #'pages-add-new-page)
- (define-key map "\C-m" #'mark-page)
- (define-key map "\C-s" #'pages-search)
- (define-key map "s" #'pages-sort-buffer)
- (define-key map "\C-l" #'pages-set-delimiter)
- (define-key map "\C-d" #'pages-directory)
- (define-key map "d" #'pages-directory-for-addresses)
- map)
- "Keymap for subcommands of C-x C-p, which are for page handling.")
+(defvar-keymap pages--ctl-x-ctl-p-map
+ :doc "Keymap for subcommands of \\`C-x C-p', which are for page handling."
+ "C-n" #'pages-next-page
+ "C-p" #'pages-previous-page
+ "C-a" #'pages-add-new-page
+ "C-m" #'mark-page
+ "C-s" #'pages-search
+ "s" #'pages-sort-buffer
+ "C-l" #'pages-set-delimiter
+ "C-d" #'pages-directory
+ "d" #'pages-directory-for-addresses)
;; FIXME: Merely loading a package shouldn't have this kind of side-effects!
(global-unset-key "\C-x\C-p")
@@ -476,14 +474,12 @@ contain matches to the regexp.)")
(define-obsolete-variable-alias 'pages-directory-map
'pages-directory-mode-map "26.1")
-(defvar pages-directory-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\C-c\C-c" #'pages-directory-goto)
- (define-key map "\C-m" #'pages-directory-goto)
- (define-key map "\C-c\C-p\C-a" #'pages-add-new-page)
- (define-key map [mouse-2] #'pages-directory-goto)
- map)
- "Keymap for the pages-directory-buffer.")
+(defvar-keymap pages-directory-mode-map
+ :doc "Keymap for the pages-directory-buffer."
+ "C-c C-c" #'pages-directory-goto
+ "RET" #'pages-directory-goto
+ "C-c C-p C-a" #'pages-add-new-page
+ "<mouse-2>" #'pages-directory-goto)
(defvar pages-original-delimiter "^\f"
"Default page delimiter.")
diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el
index f3f95627af..41a5b52f99 100644
--- a/lisp/textmodes/reftex-cite.el
+++ b/lisp/textmodes/reftex-cite.el
@@ -96,7 +96,7 @@ Find the bof of the current file."
"Return list of bibfiles for current document.
When using the chapterbib or bibunits package you should either
use the same database files everywhere, or separate parts using
-different databases into different files (included into the mater file).
+different databases into different files (included into the master file).
Then this function will return the applicable database files."
;; Ensure access to scanning info
diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el
index 075ad666b3..38d6ebe7e6 100644
--- a/lisp/textmodes/reftex-index.el
+++ b/lisp/textmodes/reftex-index.el
@@ -1807,7 +1807,7 @@ With optional arg ALLOW-NEWLINE, allow single newline
between words."
(defun reftex-index-phrases-find-dup-re (phrase &optional sub)
"Return a regexp which matches variations of PHRASE (with additional space).
When SUB ins non-nil, the regexp will also match when PHRASE is a subphrase
-of another phrase. The regexp works lonly in the phrase buffer."
+of another phrase. The regexp works only in the phrase buffer."
(concat (if sub "^\\S-?\t\\([^\t\n]*" "^\\S-?\t")
(mapconcat #'regexp-quote (split-string phrase) " +")
(if sub "[^\t\n]*\\)\\([\t\n]\\|$\\)" " *\\([\t\n]\\|$\\)")))
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
index 7d691430ec..7ce30cba8a 100644
--- a/lisp/textmodes/sgml-mode.el
+++ b/lisp/textmodes/sgml-mode.el
@@ -268,7 +268,7 @@ Currently, only Latin-1 characters are supported.")
;; prefer tidy because (o)nsgmls is often built without --enable-http
;; which makes it next to useless
(cond ((executable-find "tidy")
- ;; tidy is available from http://tidy.sourceforge.net/
+ ;; tidy is available from https://tidy.sourceforge.net/
"tidy --gnu-emacs yes -utf8 -e -q")
((executable-find "nsgmls")
;; nsgmls is a free SGML parser in the SP suite available from
@@ -276,7 +276,7 @@ Currently, only Latin-1 characters are supported.")
"nsgmls -s")
((executable-find "onsgmls")
;; onsgmls is the community version of `nsgmls'
- ;; hosted on http://openjade.sourceforge.net/
+ ;; hosted on https://openjade.sourceforge.net/
"onsgmls -s")
(t "Install (o)nsgmls, tidy, or some other SGML validator, and set
`sgml-validate-command'"))
"The command to validate an SGML document.
diff --git a/lisp/textmodes/string-edit.el b/lisp/textmodes/string-edit.el
index 53850674ac..3270050ca4 100644
--- a/lisp/textmodes/string-edit.el
+++ b/lisp/textmodes/string-edit.el
@@ -46,7 +46,9 @@ called with no parameters.
PROMPT will be inserted at the start of the buffer, but won't be
included in the resulting string. If PROMPT is nil, no help text
-will be inserted."
+will be inserted.
+
+Also see `read-string-from-buffer'."
(with-current-buffer (generate-new-buffer "*edit string*")
(when prompt
(let ((inhibit-read-only t))
@@ -88,7 +90,9 @@ The user finishes editing with
\\<string-edit-mode-map>\\[string-edit-done], or
PROMPT will be inserted at the start of the buffer, but won't be
included in the resulting string. If nil, no prompt will be
-inserted in the buffer."
+inserted in the buffer.
+
+Also see `string-edit'."
(string-edit
prompt
string
@@ -115,9 +119,7 @@ This will kill the current buffer."
(interactive)
(goto-char (point-min))
;; Skip past the help text.
- (when-let ((match (text-property-search-forward
- 'string-edit--prompt nil t)))
- (goto-char (prop-match-beginning match)))
+ (text-property-search-forward 'string-edit--prompt)
(let ((string (buffer-substring (point) (point-max)))
(callback string-edit--success-callback))
(quit-window 'kill)
diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el
index fc06c4c0da..2f34a58b5b 100644
--- a/lisp/textmodes/table.el
+++ b/lisp/textmodes/table.el
@@ -125,9 +125,7 @@
;; are tired of guessing how it works come back to this document
;; again.
;;
-;; To use the package regularly place this file in the site library
-;; directory and add the next expression in your init file. Make
-;; sure that directory is included in the `load-path'.
+;; To use the package regularly, add this to your init file:
;;
;; (require 'table)
;;
@@ -266,11 +264,6 @@
;; all a table is still a part of text in the buffer. Only the
;; special behaviors exist inside each cell through text properties.
;;
-;; `table-generate-html' which appeared in earlier releases is
-;; deprecated in favor of `table-generate-source'. Now HTML is
-;; treated as one of the languages used for describing the table's
-;; logical structure.
-;;
;;
;; -------
;; Keymap:
@@ -5221,16 +5214,15 @@ instead of the current buffer and returns the OBJECT."
"Point has entered a cell.
Refresh the menu bar."
;; Avoid calling point-motion-hooks recursively.
- (let ((inhibit-point-motion-hooks t))
- (force-mode-line-update)
- (pcase dir
- ('left
- (setq table-mode-indicator nil)
- (run-hooks 'table-point-left-cell-hook))
- ('entered
- (setq table-mode-indicator t)
- (table--warn-incompatibility)
- (run-hooks 'table-point-entered-cell-hook)))))
+ (force-mode-line-update)
+ (pcase dir
+ ('left
+ (setq table-mode-indicator nil)
+ (run-hooks 'table-point-left-cell-hook))
+ ('entered
+ (setq table-mode-indicator t)
+ (table--warn-incompatibility)
+ (run-hooks 'table-point-entered-cell-hook))))
(defun table--warn-incompatibility ()
"If called from interactive operation warn the know incompatibilities.
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
index bb8ea0d942..a1914a8cc8 100644
--- a/lisp/textmodes/tex-mode.el
+++ b/lisp/textmodes/tex-mode.el
@@ -1039,7 +1039,7 @@ says which mode to use."
;; have files annotated with -*- LaTeX -*- (e.g. because they received
;; them from someone using AUCTeX).
;; FIXME: Turn them into autoloads so that AUCTeX can override them
-;; with it's own autoloads? Or maybe rely on `major-mode-remap-alist'?
+;; with its own autoloads? Or maybe rely on `major-mode-remap-alist'?
;;;###autoload (defalias 'TeX-mode #'tex-mode)
;;;###autoload (defalias 'plain-TeX-mode #'plain-tex-mode)
;;;###autoload (defalias 'LaTeX-mode #'latex-mode)
@@ -2238,7 +2238,7 @@ of the current buffer."
"&")))
(defun tex-uptodate-p (file)
- "Return non-nil if FILE is not uptodate w.r.t the document source files.
+ "Return non-nil if FILE is not up-to-date w.r.t the document source files.
FILE is typically the output DVI or PDF file."
;; We should check all the files included !!!
(and
@@ -2375,7 +2375,7 @@ Only applies the FSPEC to the args part of FORMAT."
(push cmd tmp)))
;; Only remove if there's something left.
(if tmp (setq cmds (nreverse tmp))))
- ;; Remove commands whose input is not uptodate either.
+ ;; Remove commands whose input is not up-to-date either.
(let ((outs (delq nil (mapcar (lambda (x) (nth 2 x)) cmds)))
(tmp nil))
(dolist (cmd cmds)
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index 462f87d3c1..9dda3e1fcb 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -441,7 +441,7 @@ the bounds of a possible ill-formed URI (one lacking a
scheme)."
;; Otherwise, find the bounds within which a URI may exist. The
;; method is similar to `ffap-string-at-point'. Note that URIs
;; may contain parentheses but may not contain spaces (RFC3986).
- (let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'")
+ (let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'[]")
(skip-before "^[0-9a-zA-Z]")
(skip-after ":;.,!?'")
(pt (point))
diff --git a/lisp/thread.el b/lisp/thread.el
index 1e6e9e75a7..c0cc5feb97 100644
--- a/lisp/thread.el
+++ b/lisp/thread.el
@@ -58,20 +58,18 @@ An EVENT has the format
:type 'number
:version "27.1")
-(defvar thread-list-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map tabulated-list-mode-map)
- (define-key map "b" #'thread-list-pop-to-backtrace)
- (define-key map "s" nil)
- (define-key map "sq" #'thread-list-send-quit-signal)
- (define-key map "se" #'thread-list-send-error-signal)
- (easy-menu-define nil map ""
- '("Threads"
- ["Show backtrace" thread-list-pop-to-backtrace t]
- ["Send Quit Signal" thread-list-send-quit-signal t]
- ["Send Error Signal" thread-list-send-error-signal t]))
- map)
- "Local keymap for `thread-list-mode' buffers.")
+(defvar-keymap thread-list-mode-map
+ :doc "Local keymap for `thread-list-mode' buffers."
+ :parent tabulated-list-mode-map
+ "b" #'thread-list-pop-to-backtrace
+ "s" nil
+ "s q" #'thread-list-send-quit-signal
+ "s e" #'thread-list-send-error-signal
+ :menu
+ '("Threads"
+ ["Show backtrace" thread-list-pop-to-backtrace t]
+ ["Send Quit Signal" thread-list-send-quit-signal t]
+ ["Send Error Signal" thread-list-send-error-signal t]))
(define-derived-mode thread-list-mode tabulated-list-mode "Thread-List"
"Major mode for monitoring Lisp threads."
diff --git a/lisp/transient.el b/lisp/transient.el
index a415858970..0919c2c3ef 100644
--- a/lisp/transient.el
+++ b/lisp/transient.el
@@ -68,26 +68,6 @@
(defvar display-line-numbers) ; since Emacs 26.1
(defvar Man-notify-method)
-(define-obsolete-function-alias 'define-transient-command
- 'transient-define-prefix "Transient 0.3.0")
-(define-obsolete-function-alias 'define-suffix-command
- 'transient-define-suffix "Transient 0.3.0")
-(define-obsolete-function-alias 'define-infix-command
- 'transient-define-infix "Transient 0.3.0")
-(define-obsolete-function-alias 'define-infix-argument
- #'transient-define-argument "Transient 0.3.0")
-
-(define-obsolete-variable-alias 'transient--source-buffer
- 'transient--original-buffer "Transient 0.2.0")
-(define-obsolete-variable-alias 'current-transient-prefix
- 'transient-current-prefix "Transient 0.3.0")
-(define-obsolete-variable-alias 'current-transient-command
- 'transient-current-command "Transient 0.3.0")
-(define-obsolete-variable-alias 'current-transient-suffixes
- 'transient-current-suffixes "Transient 0.3.0")
-(define-obsolete-variable-alias 'post-transient-hook
- 'transient-exit-hook "Transient 0.3.0")
-
(defmacro transient--with-emergency-exit (&rest body)
(declare (indent defun))
`(condition-case err
@@ -893,8 +873,20 @@ to the setup function:
(put ',name 'transient--prefix
(,(or class 'transient-prefix) :command ',name ,@slots))
(put ',name 'transient--layout
- ',(cl-mapcan (lambda (s) (transient--parse-child name s))
- suffixes)))))
+ (list ,@(cl-mapcan (lambda (s) (transient--parse-child name s))
+ suffixes))))))
+
+(defmacro transient-define-groups (name &rest groups)
+ "Define one or more GROUPS and store them in symbol NAME.
+GROUPS, defined using this macro, can be used inside the
+definition of transient prefix commands, by using the symbol
+NAME where a group vector is expected. GROUPS has the same
+form as for `transient-define-prefix'."
+ (declare (debug (&define name [&rest vectorp]))
+ (indent defun))
+ `(put ',name 'transient--layout
+ (list ,@(cl-mapcan (lambda (group) (transient--parse-child name group))
+ groups))))
(defmacro transient-define-suffix (name arglist &rest args)
"Define NAME as a transient suffix command.
@@ -1000,9 +992,8 @@ example, sets a variable use `transient-define-infix'
instead.
(push k keys)
(push v keys))))
(while (let ((arg (car args)))
- (if (vectorp arg)
- (setcar args (eval (cdr (backquote-process arg))))
- (and arg (symbolp arg))))
+ (or (vectorp arg)
+ (and arg (symbolp arg))))
(push (pop args) suffixes))
(list (if (eq (car-safe class) 'quote)
(cadr class)
@@ -1035,17 +1026,24 @@ example, sets a variable use `transient-define-infix'
instead.
(when (stringp car)
(setq args (plist-put args :description pop)))
(while (keywordp car)
- (let ((k pop))
- (if (eq k :class)
- (setq class pop)
- (setq args (plist-put args k pop)))))
- (vector (or level transient--default-child-level)
- (or class
- (if (vectorp car)
- 'transient-columns
- 'transient-column))
- args
- (cl-mapcan (lambda (s) (transient--parse-child prefix s))
spec)))))
+ (let ((key pop)
+ (val pop))
+ (cond ((eq key :class)
+ (setq class (macroexp-quote val)))
+ ((or (symbolp val)
+ (and (listp val) (not (eq (car val) 'lambda))))
+ (setq args (plist-put args key (macroexp-quote val))))
+ ((setq args (plist-put args key val))))))
+ (list 'vector
+ (or level transient--default-child-level)
+ (or class
+ (if (vectorp car)
+ (quote 'transient-columns)
+ (quote 'transient-column)))
+ (and args (cons 'list args))
+ (cons 'list
+ (cl-mapcan (lambda (s) (transient--parse-child prefix s))
+ spec))))))
(defun transient--parse-suffix (prefix spec)
(let (level class args)
@@ -1057,17 +1055,19 @@ example, sets a variable use `transient-define-infix'
instead.
(when (or (stringp car)
(vectorp car))
(setq args (plist-put args :key pop)))
- (when (or (stringp car)
- (eq (car-safe car) 'lambda)
- (and (symbolp car)
- (not (commandp car))
- (commandp (cadr spec))))
+ (cond
+ ((or (stringp car)
+ (eq (car-safe car) 'lambda))
(setq args (plist-put args :description pop)))
+ ((and (symbolp car)
+ (not (commandp car))
+ (commandp (cadr spec)))
+ (setq args (plist-put args :description (macroexp-quote pop)))))
(cond
((keywordp car)
(error "Need command, got %S" car))
((symbolp car)
- (setq args (plist-put args :command pop)))
+ (setq args (plist-put args :command (macroexp-quote pop))))
((and (commandp car)
(not (stringp car)))
(let ((cmd pop)
@@ -1076,7 +1076,7 @@ example, sets a variable use `transient-define-infix'
instead.
(or (plist-get args :description)
(plist-get args :key))))))
(defalias sym cmd)
- (setq args (plist-put args :command sym))))
+ (setq args (plist-put args :command (macroexp-quote sym)))))
((or (stringp car)
(and car (listp car)))
(let ((arg pop))
@@ -1090,11 +1090,11 @@ example, sets a variable use `transient-define-infix'
instead.
(setq args (plist-put args :shortarg shortarg)))
(setq args (plist-put args :argument arg))))
(setq args (plist-put args :command
- (intern (format "transient:%s:%s"
- prefix arg))))
+ (list 'quote (intern (format "transient:%s:%s"
+ prefix arg)))))
(cond ((and car (not (keywordp car)))
(setq class 'transient-option)
- (setq args (plist-put args :reader pop)))
+ (setq args (plist-put args :reader (macroexp-quote pop))))
((not (string-suffix-p "=" arg))
(setq class 'transient-switch))
(t
@@ -1102,17 +1102,23 @@ example, sets a variable use `transient-define-infix'
instead.
(t
(error "Needed command or argument, got %S" car)))
(while (keywordp car)
- (let ((k pop))
- (cl-case k
- (:class (setq class pop))
- (:level (setq level pop))
- (t (setq args (plist-put args k pop)))))))
+ (let ((key pop)
+ (val pop))
+ (cond ((eq key :class) (setq class val))
+ ((eq key :level) (setq level val))
+ ((eq (car-safe val) '\,)
+ (setq args (plist-put args key (cadr val))))
+ ((or (symbolp val)
+ (and (listp val) (not (eq (car val) 'lambda))))
+ (setq args (plist-put args key (macroexp-quote val))))
+ ((setq args (plist-put args key val)))))))
(unless (plist-get args :key)
(when-let ((shortarg (plist-get args :shortarg)))
(setq args (plist-put args :key shortarg))))
- (list (or level transient--default-child-level)
- (or class 'transient-suffix)
- args)))
+ (list 'list
+ (or level transient--default-child-level)
+ (macroexp-quote (or class 'transient-suffix))
+ (cons 'list args))))
(defun transient--default-infix-command ()
(cons 'lambda
@@ -1139,6 +1145,22 @@ example, sets a variable use `transient-define-infix'
instead.
(and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg)
(match-string 1 arg))))
+(defun transient-parse-suffix (prefix suffix)
+ "Parse SUFFIX, to be added to PREFIX.
+PREFIX is a prefix command, a symbol.
+SUFFIX is a suffix command or a group specification (of
+ the same forms as expected by `transient-define-prefix').
+Intended for use in PREFIX's `:setup-children' function."
+ (eval (car (transient--parse-child prefix suffix))))
+
+(defun transient-parse-suffixes (prefix suffixes)
+ "Parse SUFFIXES, to be added to PREFIX.
+PREFIX is a prefix command, a symbol.
+SUFFIXES is a list of suffix command or a group specification
+ (of the same forms as expected by `transient-define-prefix').
+Intended for use in PREFIX's `:setup-children' function."
+ (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes))
+
;;; Edit
(defun transient--insert-suffix (prefix loc suffix action &optional keep-other)
@@ -1148,6 +1170,7 @@ example, sets a variable use `transient-define-infix'
instead.
(string suffix)))
(mem (transient--layout-member loc prefix))
(elt (car mem)))
+ (setq suf (eval suf))
(cond
((not mem)
(message "Cannot insert %S into %s; %s not found"
@@ -1448,7 +1471,10 @@ probably use this instead:
transient-current-prefix)
(cl-find-if (lambda (obj)
(eq (transient--suffix-command obj)
- (or command this-command)))
+ ;; When `this-command' is `transient-set-level',
+ ;; its reader needs to know what command is being
+ ;; configured.
+ (or command this-original-command)))
(or transient--suffixes
transient-current-suffixes))
(when-let* ((obj (get (or command this-command) 'transient--suffix))
@@ -1555,32 +1581,39 @@ to `transient-predicate-map'. Also see
`transient-base-map'.")
(put 'transient-common-commands
'transient--layout
- (cl-mapcan
- (lambda (s) (transient--parse-child 'transient-common-commands s))
- `([:hide ,(lambda ()
- (and (not (memq (car (bound-and-true-p
- transient--redisplay-key))
- transient--common-command-prefixes))
- (not transient-show-common-commands)))
- ["Value commands"
- ("C-x s " "Set" transient-set)
- ("C-x C-s" "Save" transient-save)
- ("C-x C-k" "Reset" transient-reset)
- ("C-x p " "Previous value" transient-history-prev)
- ("C-x n " "Next value" transient-history-next)]
- ["Sticky commands"
- ;; Like `transient-sticky-map' except that
- ;; "C-g" has to be bound to a different command.
- ("C-g" "Quit prefix or transient" transient-quit-one)
- ("C-q" "Quit transient stack" transient-quit-all)
- ("C-z" "Suspend transient stack" transient-suspend)]
- ["Customize"
- ("C-x t" transient-toggle-common
- :description ,(lambda ()
- (if transient-show-common-commands
- "Hide common commands"
- "Show common permanently")))
- ("C-x l" "Show/hide suffixes" transient-set-level)]])))
+ (list
+ (eval
+ (car (transient--parse-child
+ 'transient-common-commands
+ (vector
+ :hide
+ (lambda ()
+ (and (not (memq
+ (car (bound-and-true-p transient--redisplay-key))
+ transient--common-command-prefixes))
+ (not transient-show-common-commands)))
+ (vector
+ "Value commands"
+ (list "C-x s " "Set" #'transient-set)
+ (list "C-x C-s" "Save" #'transient-save)
+ (list "C-x C-k" "Reset" #'transient-reset)
+ (list "C-x p " "Previous value" #'transient-history-prev)
+ (list "C-x n " "Next value" #'transient-history-next))
+ (vector
+ "Sticky commands"
+ ;; Like `transient-sticky-map' except that
+ ;; "C-g" has to be bound to a different command.
+ (list "C-g" "Quit prefix or transient" #'transient-quit-one)
+ (list "C-q" "Quit transient stack" #'transient-quit-all)
+ (list "C-z" "Suspend transient stack" #'transient-suspend))
+ (vector
+ "Customize"
+ (list "C-x t" 'transient-toggle-common :description
+ (lambda ()
+ (if transient-show-common-commands
+ "Hide common commands"
+ "Show common permanently")))
+ (list "C-x l" "Show/hide suffixes" #'transient-set-level))))))))
(defvar transient-popup-navigation-map
(let ((map (make-sparse-keymap)))
@@ -2176,7 +2209,8 @@ value. Otherwise return CHILDREN as is."
;; used to call another command
;; that also uses the minibuffer.
(equal
- (string-to-multibyte (this-command-keys))
+ (ignore-errors
+ (string-to-multibyte (this-command-keys)))
(format "\M-x%s\r" this-command))))))
(transient--debug 'post-command-hook "act: %s" act)
(when act
@@ -3501,7 +3535,7 @@ Optional support for popup buttons is also implemented
here."
(cl-defmethod transient-format-description ((obj transient-child))
"The `description' slot may be a function, in which case that is
-called inside the correct buffer (see `transient-insert-group')
+called inside the correct buffer (see `transient--insert-group')
and its value is returned to the caller."
(and-let* ((desc (oref obj description)))
(if (functionp desc)
@@ -3669,7 +3703,14 @@ manpage, then try to jump to the correct location."
(defun transient--describe-function (fn)
(describe-function (if (symbolp fn) fn 'transient--anonymous-infix-argument))
- (select-window (get-buffer-window (help-buffer))))
+ (unless (derived-mode-p 'help-mode)
+ (when-let* ((buf (get-buffer "*Help*"))
+ (win (or (and buf (get-buffer-window buf))
+ (cl-find-if (lambda (win)
+ (with-current-buffer (window-buffer win)
+ (derived-mode-p 'help-mode)))
+ (window-list)))))
+ (select-window win))))
(defun transient--anonymous-infix-argument ()
"Cannot show any documentation for this anonymous infix command.
diff --git a/lisp/url/ChangeLog.1 b/lisp/url/ChangeLog.1
index 2f7813e64c..1b5ddc1e76 100644
--- a/lisp/url/ChangeLog.1
+++ b/lisp/url/ChangeLog.1
@@ -366,7 +366,7 @@
* url.el, url-queue.el, url-parse.el, url-http.el, url-future.el:
* url-dav.el, url-cookie.el: Use cl-lib.
* url-util.el, url-privacy.el, url-nfs.el, url-misc.el, url-methods.el:
- * url-gw.el, url-file.el, url-expand.el: Dont use CL.
+ * url-gw.el, url-file.el, url-expand.el: Don't use CL.
2012-06-30 Glenn Morris <rgm@gnu.org>
diff --git a/lisp/url/url-file.el b/lisp/url/url-file.el
index a72b2e67a6..6258e999c1 100644
--- a/lisp/url/url-file.el
+++ b/lisp/url/url-file.el
@@ -150,7 +150,6 @@ it up to them."
(uncompressed-filename nil)
(content-type nil)
(content-encoding nil)
- (coding-system-for-read 'binary)
(filename (url-file-build-filename url)))
(or filename (error "File does not exist: %s" (url-recreate-url url)))
;; Need to figure out the content-type from the real extension,
diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el
index 9161f7d13e..f97b6de6fe 100644
--- a/lisp/url/url-irc.el
+++ b/lisp/url/url-irc.el
@@ -38,11 +38,13 @@ The function should take the following arguments:
PORT - the port number of the IRC server to contact
CHANNEL - What channel on the server to visit right away (can be nil)
USER - What username to use
-PASSWORD - What password to use"
+PASSWORD - What password to use.
+ SCHEME - a URI scheme, such as \"irc\" or \"ircs\""
:type '(choice (const :tag "rcirc" :value url-irc-rcirc)
(const :tag "ERC" :value url-irc-erc)
(const :tag "ZEN IRC" :value url-irc-zenirc)
(function :tag "Other"))
+ :version "29.1" ; Added SCHEME
:group 'url)
;; External.
@@ -51,7 +53,7 @@ PASSWORD - What password to use"
(defvar zenirc-server-alist)
(defvar zenirc-buffer-name)
-(defun url-irc-zenirc (host port channel user password)
+(defun url-irc-zenirc (host port channel user password _)
(let ((zenirc-buffer-name (if (and user host port)
(format "%s@%s:%d" user host port)
(format "%s:%d" host port)))
@@ -65,14 +67,14 @@ PASSWORD - What password to use"
(insert "/join " channel)
(zenirc-send-line))))
-(defun url-irc-rcirc (host port channel user password)
+(defun url-irc-rcirc (host port channel user password _)
(let ((chan (when channel (concat "#" channel))))
(rcirc-connect host port user nil nil (when chan (list chan)) password)
(when chan
(switch-to-buffer (concat chan "@" host)))))
-(defun url-irc-erc (host port channel user password)
- (erc-handle-irc-url host port channel user password))
+(defun url-irc-erc (host port channel user password scheme)
+ (erc-handle-irc-url host port channel user password scheme))
;;;###autoload
(defun url-irc (url)
@@ -80,16 +82,32 @@ PASSWORD - What password to use"
(port (url-port url))
(pass (url-password url))
(user (url-user url))
- (chan (url-filename url)))
+ (chan (url-filename url))
+ (type (url-type url))
+ (compatp (eql 5 (cdr (func-arity url-irc-function)))))
(if (url-target url)
(setq chan (concat chan "#" (url-target url))))
(if (string-match "^/" chan)
(setq chan (substring chan 1 nil)))
(if (= (length chan) 0)
(setq chan nil))
- (funcall url-irc-function host port chan user pass)
+ (when compatp
+ (lwarn 'url :error "Obsolete value for `url-irc-function'"))
+ (apply url-irc-function
+ host port chan user pass (unless compatp (list type)))
nil))
+;;;; ircs://
+
+;; The function `url-scheme-get-property' tries and fails to load the
+;; nonexistent url-ircs.el but falls back to using the following:
+
+;;;###autoload
+(defconst url-ircs-default-port 6697 "Default port for IRCS connections.")
+
+;;;###autoload
+(defalias 'url-ircs 'url-irc)
+
(provide 'url-irc)
;;; url-irc.el ends here
diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el
index 147a643c9f..95c0fe14f3 100644
--- a/lisp/url/url-util.el
+++ b/lisp/url/url-util.el
@@ -63,9 +63,9 @@ If a list, it is a list of the types of messages to be
logged."
(and (listp url-debug) (memq tag url-debug)))
(with-current-buffer (get-buffer-create "*URL-DEBUG*")
(goto-char (point-max))
- (insert (symbol-name tag) " -> " (apply 'format args) "\n")
+ (insert (symbol-name tag) " -> " (apply #'format args) "\n")
(if (numberp url-debug)
- (apply 'message args)))))
+ (apply #'message args)))))
;;;###autoload
(defun url-parse-args (str &optional nodowncase)
@@ -125,23 +125,13 @@ conversion. Replaces these characters as follows:
< ==> <
> ==> >
\" ==> ""
- (if (string-match "[&<>\"]" string)
- (with-current-buffer (get-buffer-create " *entity*")
- (erase-buffer)
- (buffer-disable-undo (current-buffer))
- (insert string)
- (goto-char (point-min))
- (while (progn
- (skip-chars-forward "^&<>\"")
- (not (eobp)))
- (insert (cdr (assq (char-after (point))
- '((?\" . """)
- (?& . "&")
- (?< . "<")
- (?> . ">")))))
- (delete-char 1))
- (buffer-string))
- string))
+ (replace-regexp-in-string "[&<>\"]"
+ (lambda (c) (cdr (assq (aref c 0)
+ '((?\" . """)
+ (?& . "&")
+ (?< . "<")
+ (?> . ">")))))
+ string))
;;;###autoload
(defun url-normalize-url (url)
@@ -169,7 +159,7 @@ Will not do anything if `url-show-status' is nil."
(= url-lazy-message-time
(setq url-lazy-message-time (time-convert nil 'integer))))
nil
- (apply 'message args)))
+ (apply #'message args)))
;;;###autoload
(defun url-get-normalized-date (&optional specified-time)
@@ -186,7 +176,7 @@ Will not do anything if `url-show-status' is nil."
#'string-trim-left "29.1")
(define-obsolete-function-alias 'url-pretty-length
- 'file-size-human-readable "24.4")
+ #'file-size-human-readable "24.4")
;;;###autoload
(defun url-display-message (fmt &rest args)
@@ -206,7 +196,7 @@ Will not do anything if `url-show-status' is nil."
(round (* 100 (/ x (float y)))))
;;;###autoload
-(defalias 'url-basepath 'url-file-directory)
+(defalias 'url-basepath #'url-file-directory)
;;;###autoload
(defun url-file-directory (file)
@@ -395,8 +385,7 @@ if character N is allowed."
(aref url-encoding-table byte)))
(if (multibyte-string-p string)
(encode-coding-string string 'utf-8)
- string)
- ""))
+ string)))
(defconst url-host-allowed-chars
;; Allow % to avoid re-encoding %-encoded sequences.
diff --git a/lisp/url/url.el b/lisp/url/url.el
index b4ece5faeb..92057742ca 100644
--- a/lisp/url/url.el
+++ b/lisp/url/url.el
@@ -293,7 +293,7 @@ how long to wait for a response before giving up."
(declare-function mm-display-part "mm-decode"
(handle &optional no-default force))
-(defun url-mm-callback (&rest ignored)
+(defun url-mm-callback (&rest _ignored)
(let ((handle (mm-dissect-buffer t)))
(url-mark-buffer-as-dead (current-buffer))
(with-current-buffer
diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el
index e3c0e2ca06..a1d6152ee2 100644
--- a/lisp/vc/add-log.el
+++ b/lisp/vc/add-log.el
@@ -1188,7 +1188,7 @@ file were isearch was started."
((and wrap (null file))
(current-buffer))
;; When there is no next file, file-exists-p raises the error to be
- ;; catched by the search function that displays the error message.
+ ;; caught by the search function that displays the error message.
((file-exists-p file)
(find-file-noselect file))
(t
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index a9591c9d82..357ce001b3 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -306,7 +306,7 @@ well."
;; terminal supporting 24 bit colors) doesn't render well in terminal
;; supporting only 256 colors. Concretely, both #ffeeee
;; (diff-removed) and #eeffee (diff-added) are mapped to the same
-;; greyish color. "min-colors 257" ensures that those colors are not
+;; grayish color. "min-colors 257" ensures that those colors are not
;; used terminals supporting only 256 colors. However, any number
;; between 257 and 2^24 (16777216) would do.
diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el
index 07b853817d..24647de576 100644
--- a/lisp/vc/ediff-diff.el
+++ b/lisp/vc/ediff-diff.el
@@ -942,6 +942,9 @@ one optional arguments, diff-number to refine.")
(c-prev-pt nil)
(anc-prev 1)
diff-list shift-A shift-B shift-C
+ (A-idx "1")
+ (B-idx (if three-way-comp "2" "3"))
+ (C-idx (if three-way-comp "3" "2"))
)
;; diff list contains word numbers or points, depending on word-mode
@@ -979,23 +982,23 @@ one optional arguments, diff-number to refine.")
(let ((agreement (buffer-substring (match-beginning 1) (match-end 1))))
;; if the files A and B are the same and not 3way-comparison,
;; ignore the difference
- (if (or three-way-comp (not (string-equal agreement "3")))
- (let* ((a-begin (car (ediff-get-diff3-group "1")))
- (a-end (nth 1 (ediff-get-diff3-group "1")))
- (b-begin (car (ediff-get-diff3-group "2")))
- (b-end (nth 1 (ediff-get-diff3-group "2")))
- (c-or-anc-begin (car (ediff-get-diff3-group "3")))
- (c-or-anc-end (nth 1 (ediff-get-diff3-group "3")))
+ (if (or three-way-comp (not (string-equal agreement C-idx)))
+ (let* ((a-begin (car (ediff-get-diff3-group A-idx)))
+ (a-end (nth 1 (ediff-get-diff3-group A-idx)))
+ (b-begin (car (ediff-get-diff3-group B-idx)))
+ (b-end (nth 1 (ediff-get-diff3-group B-idx)))
+ (c-or-anc-begin (car (ediff-get-diff3-group C-idx)))
+ (c-or-anc-end (nth 1 (ediff-get-diff3-group C-idx)))
(state-of-merge
- (cond ((string-equal agreement "1") 'prefer-A)
- ((string-equal agreement "2") 'prefer-B)
+ (cond ((string-equal agreement A-idx) 'prefer-A)
+ ((string-equal agreement B-idx) 'prefer-B)
(t ediff-default-variant)))
(state-of-diff-merge
(if (memq state-of-merge '(default-A prefer-A)) 'B 'A))
(state-of-diff-comparison
- (cond ((string-equal agreement "1") 'A)
- ((string-equal agreement "2") 'B)
- ((string-equal agreement "3") 'C)))
+ (cond ((string-equal agreement A-idx) 'A)
+ ((string-equal agreement B-idx) 'B)
+ ((string-equal agreement C-idx) 'C)))
state-of-ancestor
c-begin c-end
a-begin-pt a-end-pt
@@ -1108,8 +1111,12 @@ one optional arguments, diff-number to refine.")
(get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*"))))
(message "Computing differences ...")
- (ediff-exec-process ediff-diff3-program ediff-diff-buffer 'synchronize
- ediff-actual-diff3-options file-A file-B file-C)
+ (apply #'ediff-exec-process ediff-diff3-program ediff-diff-buffer
'synchronize
+ ediff-actual-diff3-options
+ (cons file-A (if ediff-merge-with-ancestor-job
+ ;; Ancestor must be the middle file
+ (list file-C file-B)
+ (list file-B file-C))))
(ediff-prepare-error-list ediff-diff3-ok-lines-regexp ediff-diff-buffer)
;;(message "Computing differences ... done")
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index 0d96a195ad..f406883221 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -1748,7 +1748,7 @@ With a prefix argument ARG, go back that many
differences."
regexp-skip
;; skip clashes, if necessary
non-clash-skip
- ;; skipp changed regions
+ ;; skip changed regions
skip-changed
;; skip difference regions that differ in white space
(and ediff-ignore-similar-regions
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index 415b1564ed..7a710386fe 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -359,6 +359,7 @@ log entries."
(overlay-put ov 'log-view-self ov)
(overlay-put ov 'log-view-marked (nth 1 entry))))))))
+;;;###autoload
(defun log-view-get-marked ()
"Return the list of tags for the marked log entries."
(save-excursion
diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el
index 003b26eca4..e13894d6b5 100644
--- a/lisp/vc/smerge-mode.el
+++ b/lisp/vc/smerge-mode.el
@@ -23,11 +23,10 @@
;;; Commentary:
;; Provides a lightweight alternative to emerge/ediff.
-;; To use it, simply add to your .emacs the following lines:
;;
-;; (autoload 'smerge-mode "smerge-mode" nil t)
+;; To use it, simply type `M-x smerge-mode'.
;;
-;; you can even have it turned on automatically with the following
+;; You can even have it turned on automatically with the following
;; piece of code in your .emacs:
;;
;; (defun sm-try-smerge ()
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index bce7996712..8f00441e81 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -532,6 +532,12 @@ in the branch repository (or whose status not be
determined)."
(add-hook 'after-save-hook #'vc-bzr-resolve-when-done nil t)
(vc-message-unresolved-conflicts buffer-file-name)))
+(defun vc-bzr-clone (remote directory rev)
+ (if rev
+ (vc-bzr-command nil 0 '() "branch" "-r" rev remote directory)
+ (vc-bzr-command nil 0 '() "branch" remote directory))
+ directory)
+
(defun vc-bzr-version-dirstate (dir)
"Try to return as a string the bzr revision ID of directory DIR.
This uses the dirstate file's parent revision entry.
@@ -1324,6 +1330,20 @@ stream. Standard error output is discarded."
(match-string 1)
(error "Cannot determine Bzr repository URL")))))
+(defun vc-bzr-prepare-patch (rev)
+ (with-current-buffer (generate-new-buffer " *vc-bzr-prepare-patch*")
+ (vc-bzr-command
+ "send" t 0 '()
+ "--revision" (concat (vc-bzr-previous-revision nil rev) ".." rev)
+ "--output" "-")
+ (let (subject)
+ ;; Extract the subject line
+ (goto-char (point-min))
+ (search-forward-regexp "^[^#].*")
+ (setq subject (match-string 0))
+ ;; Return the extracted data
+ (list :subject subject :buffer (current-buffer)))))
+
(provide 'vc-bzr)
;;; vc-bzr.el ends here
diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el
index 94621599e4..1cd91c9f54 100644
--- a/lisp/vc/vc-dav.el
+++ b/lisp/vc/vc-dav.el
@@ -93,7 +93,7 @@ If EDITABLE is non-nil URL should be writable by the user and
if
locking is used for URL, a lock should also be set.
If REV is non-nil, that is the revision to check out. If REV is the
-empty string, that means to check ou tht ehead of the trunk.
+empty string, that means to check out the head of the trunk.
If optional arg DESTFILE is given, it is an alternate filename to
write the contents to."
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 4a2a42ad2a..a1ff03144b 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -95,6 +95,7 @@
;; - find-file-hook () OK
;; - conflicted-files OK
;; - repository-url (file-or-dir) OK
+;; - prepare-patch (rev) OK
;;; Code:
@@ -1266,6 +1267,12 @@ This prompts for a branch to merge from."
(add-hook 'after-save-hook #'vc-git-resolve-when-done nil 'local))
(vc-message-unresolved-conflicts buffer-file-name)))
+(defun vc-git-clone (remote directory rev)
+ (if rev
+ (vc-git--out-ok "clone" "--branch" rev remote directory)
+ (vc-git--out-ok "clone" remote directory))
+ directory)
+
;;; HISTORY FUNCTIONS
(autoload 'vc-setup-buffer "vc-dispatcher")
@@ -1624,6 +1631,19 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(expand-file-name fname (vc-git-root default-directory))))
revision)))))
+(defun vc-git-last-change (file line)
+ (vc-buffer-sync)
+ (let ((file (file-relative-name file (vc-git-root (buffer-file-name)))))
+ (with-temp-buffer
+ (when (vc-git--out-ok
+ "blame" "--porcelain"
+ (format "-L%d,+1" line)
+ file)
+ (goto-char (point-min))
+ (save-match-data
+ (when (looking-at "\\`\\([[:alnum:]]+\\)[[:space:]]+")
+ (match-string 1)))))))
+
;;; TAG/BRANCH SYSTEM
(declare-function vc-read-revision "vc"
@@ -1634,7 +1654,7 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(start-point (when branchp (vc-read-revision
(format-prompt "Start point"
(car (vc-git-branches)))
- (list dir) 'Git))))
+ (list dir) 'Git (car (vc-git-branches))))))
(and (or (zerop (vc-git-command nil t nil "update-index" "--refresh"))
(y-or-n-p "Modified files exist. Proceed? ")
(user-error (format "Can't create %s with modified files"
@@ -1742,6 +1762,29 @@ This requires git 1.8.4 or later, for the \"-L\" option
of \"git log\"."
(defun vc-git-root (file)
(vc-find-root file ".git"))
+(defun vc-git-prepare-patch (rev)
+ (with-current-buffer (generate-new-buffer " *vc-git-prepare-patch*")
+ (vc-git-command
+ t 0 '() "format-patch"
+ "--no-numbered" "--stdout"
+ ;; From gitrevisions(7): ^<n> means the <n>th parent
+ ;; (i.e. <rev>^ is equivalent to <rev>^1). As a
+ ;; special rule, <rev>^0 means the commit itself and
+ ;; is used when <rev> is the object name of a tag
+ ;; object that refers to a commit object.
+ (concat rev "^.." rev))
+ (let (subject)
+ ;; Extract the subject line
+ (goto-char (point-min))
+ (search-forward-regexp "^Subject: \\(.+\\)")
+ (setq subject (match-string 1))
+ ;; Jump to the beginning for the patch
+ (search-forward-regexp "\n\n")
+ ;; Return the extracted data
+ (list :subject subject
+ :buffer (current-buffer)
+ :body-start (point)))))
+
;; grep-compute-defaults autoloads grep.
(declare-function grep-read-regexp "grep" ())
(declare-function grep-read-files "grep" (regexp))
@@ -1840,7 +1883,8 @@ This command shares argument histories with \\[rgrep] and
\\[grep]."
"Show the contents of stash NAME."
(interactive (list (vc-git-stash-read "Show stash: ")))
(vc-setup-buffer "*vc-git-stash*")
- (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name)
+ (vc-git-command "*vc-git-stash*" 'async nil
+ "stash" "show" "--color=never" "-p" name)
(set-buffer "*vc-git-stash*")
(setq buffer-read-only t)
(diff-mode)
@@ -2001,19 +2045,23 @@ FILE can be nil."
(setq ok nil))))))
(and ok str)))
-(defun vc-git-symbolic-commit (commit)
- "Translate COMMIT string into symbolic form.
-Returns nil if not possible."
+(defun vc-git-symbolic-commit (commit &optional force)
+ "Translate revision string of COMMIT to a symbolic form.
+If the optional argument FORCE is non-nil, the returned value is
+allowed to include revision specifications like \"master~8\"
+\(the 8th parent of the commit currently pointed to by the master
+branch), otherwise such revision specifications are rejected, and
+the function returns nil."
(and commit
- (let ((name (with-temp-buffer
- (and
- (vc-git--out-ok "name-rev" "--name-only" commit)
- (goto-char (point-min))
- (= (forward-line 2) 1)
- (bolp)
- (buffer-substring-no-properties (point-min)
- (1- (point-max)))))))
- (and name (not (string= name "undefined")) name))))
+ (with-temp-buffer
+ (and
+ (vc-git--out-ok "name-rev" "--no-undefined" "--name-only" commit)
+ (goto-char (point-min))
+ (or force (not (looking-at "^.*[~^].*$" t)))
+ (= (forward-line 2) 1)
+ (bolp)
+ (buffer-substring-no-properties (point-min)
+ (1- (point-max)))))))
(defvar-keymap vc-dir-git-mode-map
"z c" #'vc-git-stash
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index eed9592378..90903255e0 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -51,6 +51,7 @@
;; - receive-file (file rev) ?? PROBABLY NOT NEEDED
;; - unregister (file) OK
;; * checkin (files rev comment) OK
+;; - checkin-patch (patch-string comment) OK
;; * find-revision (file rev buffer) OK
;; * checkout (file &optional rev) OK
;; * revert (file &optional contents-done) OK
@@ -80,6 +81,7 @@
;; - delete-file (file) TEST IT
;; - rename-file (old new) OK
;; - find-file-hook () added for bug#10709
+;; - prepare-patch (rev) OK
;; 2) Implement Stefan Monnier's advice:
;; vc-hg-registered and vc-hg-state
@@ -1188,16 +1190,31 @@ It is based on `log-edit-mode', and has Hg-specific
extensions.")
(defun vc-hg-checkin (files comment &optional _rev)
"Hg-specific version of `vc-backend-checkin'.
REV is ignored."
- (let ((amend-extract-fn
- (lambda (value)
- (when (equal value "yes")
- (list "--amend")))))
- (apply #'vc-hg-command nil 0 files
- (nconc (list "commit" "-m")
- (log-edit-extract-headers `(("Author" . "--user")
- ("Date" . "--date")
- ("Amend" . ,amend-extract-fn))
- comment)))))
+ (apply #'vc-hg-command nil 0 files
+ (nconc (list "commit" "-m")
+ (vc-hg--extract-headers comment))))
+
+(defun vc-hg-checkin-patch (patch-string comment)
+ (let ((patch-file (make-temp-file "hg-patch")))
+ (write-region patch-string nil patch-file)
+ (unwind-protect
+ (progn
+ (apply #'vc-hg-command nil 0 nil
+ (nconc (list "import" "--bypass" patch-file "-m")
+ (vc-hg--extract-headers comment)))
+ (vc-hg-command nil 0 nil
+ "update"
+ "--merge" "--tool" "internal:local"
+ "tip"))
+ (delete-file patch-file))))
+
+(defun vc-hg--extract-headers (comment)
+ (log-edit-extract-headers `(("Author" . "--user")
+ ("Date" . "--date")
+ ("Amend" . (lambda (value)
+ (when (equal value "yes")
+ (list "--amend")))))
+ comment))
(defun vc-hg-find-revision (file rev buffer)
(let ((coding-system-for-read 'binary)
@@ -1249,6 +1266,12 @@ REV is the revision to check out into WORKFILE."
(add-hook 'after-save-hook #'vc-hg-resolve-when-done nil t)
(vc-message-unresolved-conflicts buffer-file-name)))
+(defun vc-hg-clone (remote directory rev)
+ (if rev
+ (vc-hg-command nil 0 '() "clone" "--rev" rev remote directory)
+ (vc-hg-command nil 0 '() "clone" remote directory))
+
+ directory)
;; Modeled after the similar function in vc-bzr.el
(defun vc-hg-revert (file &optional contents-done)
@@ -1507,6 +1530,17 @@ This runs the command \"hg merge\"."
(with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg)))
(vc-set-async-update buffer)))
+(defun vc-hg-prepare-patch (rev)
+ (with-current-buffer (generate-new-buffer " *vc-hg-prepare-patch*")
+ (vc-hg-command t 0 '() "export" "--rev" rev)
+ (let (subject)
+ ;; Extract the subject line
+ (goto-char (point-min))
+ (search-forward-regexp "^[^#].*")
+ (setq subject (match-string 0))
+ ;; Return the extracted data
+ (list :subject subject :buffer (current-buffer)))))
+
;;; Internal functions
(defun vc-hg-command (buffer okstatus file-or-list &rest flags)
diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el
index a4345c7d7e..c41835e19f 100644
--- a/lisp/vc/vc-rcs.el
+++ b/lisp/vc/vc-rcs.el
@@ -1192,7 +1192,7 @@ variable `vc-rcs-release' is set to the returned value."
(defun vc-rcs-parse (&optional buffer)
"Parse current buffer, presumed to be in RCS-style masterfile format.
Optional arg BUFFER specifies another buffer to parse. Return an alist
-of two elements, w/ keys `headers' and `revisions' and values in turn
+of two elements, with keys `headers' and `revisions' and values in turn
sub-alists. For `headers', the values unless otherwise specified are
strings and the keys are:
diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el
index 9c2bdf6674..1b43ca5787 100644
--- a/lisp/vc/vc-svn.el
+++ b/lisp/vc/vc-svn.el
@@ -364,7 +364,7 @@ DIRECTORY or absolute."
(with-temp-buffer
(when (zerop (vc-svn-command
t t nil "propget" "svn:ignore" (expand-file-name directory)))
- (split-string (buffer-string) "\n"))))
+ (split-string (buffer-string) "\n" t))))
(defun vc-svn-find-admin-dir (file)
"Return the administrative directory of FILE."
@@ -817,6 +817,13 @@ Set file properties accordingly. If FILENAME is non-nil,
return its status."
"info" "--show-item" "repos-root-url")
(buffer-substring-no-properties (point-min) (1- (point-max))))))
+(defun vc-svn-clone (remote directory rev)
+ (if rev
+ (vc-svn-command nil 0 '() "checkout" "--revision" rev remote directory)
+ (vc-svn-command nil 0 '() "checkout" remote directory))
+
+ (file-name-concat directory "trunk"))
+
(provide 'vc-svn)
;;; vc-svn.el ends here
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 787dd51d07..fa3d58f770 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -448,6 +448,11 @@
;; - mergebase (rev1 &optional rev2)
;;
;; Return the common ancestor between REV1 and REV2 revisions.
+;;
+;; - last-change (file line)
+;;
+;; Return the most recent revision of FILE that made a change
+;; on LINE.
;; TAG/BRANCH SYSTEM
;;
@@ -574,6 +579,25 @@
;; containing FILE-OR-DIR. The optional REMOTE-NAME specifies the
;; remote (in Git parlance) whose URL is to be returned. It has
;; only a meaning for distributed VCS and is ignored otherwise.
+;;
+;; - prepare-patch (rev)
+;;
+;; Prepare a patch and return a property list with the keys
+;; `:subject' indicating the patch message as a string, `:buffer'
+;; with a buffer object that contains the entire patch message and
+;; `:body-start' and `:body-end' demarcating what part of said
+;; buffer should be inserted into an inline patch. If the two last
+;; properties are omitted, `point-min' and `point-max' will
+;; respectively be used instead.
+;;
+;; - clone (remote directory rev)
+;;
+;; Attempt to clone a REMOTE repository, into a local DIRECTORY.
+;; Returns a string with the directory with the contents of the
+;; repository if successful, otherwise nil. With a non-nil value
+;; for REV the backend will attempt to check out a specific
+;; revision, if possible without first checking out the default
+;; branch.
;;; Changes from the pre-25.1 API:
;;
@@ -1673,6 +1697,47 @@ Runs the normal hooks `vc-before-checkin-hook' and
`vc-checkin-hook'."
backend
patch-string))
+(defun vc-default-checkin-patch (_backend patch-string comment)
+ (pcase-let* ((`(,backend ,files) (with-temp-buffer
+ (insert patch-string)
+ (diff-vc-deduce-fileset)))
+ (tmpdir (make-temp-file "vc-checkin-patch" t)))
+ (dolist (f files)
+ (make-directory (file-name-directory (expand-file-name f tmpdir)) t)
+ (copy-file (expand-file-name f)
+ (expand-file-name f tmpdir)))
+ (unwind-protect
+ (progn
+ (dolist (f files)
+ (with-current-buffer (find-file-noselect f)
+ (vc-revert-file buffer-file-name)))
+ (with-temp-buffer
+ ;; Trying to support CVS too. Assuming that vc-diff
+ ;; there will usually have diff root in default-directory.
+ (when (vc-find-backend-function backend 'root)
+ (setq-local default-directory
+ (vc-call-backend backend 'root (car files))))
+ (unless (eq 0
+ (call-process-region patch-string
+ nil
+ "patch"
+ nil
+ t
+ nil
+ "-p1"
+ "-r" null-device
+ "--no-backup-if-mismatch"
+ "-i" "-"))
+ (user-error "Patch failed: %s" (buffer-string))))
+ (vc-call-backend backend 'checkin files comment))
+ (dolist (f files)
+ (copy-file (expand-file-name f tmpdir)
+ (expand-file-name f)
+ t)
+ (with-current-buffer (get-file-buffer f)
+ (revert-buffer t t t)))
+ (delete-directory tmpdir t))))
+
;;; Additional entry points for examining version histories
;; (defun vc-default-diff-tree (backend dir rev1 rev2)
@@ -1910,7 +1975,14 @@ Return t if the buffer had changes, nil otherwise."
(defvar vc-revision-history nil
"History for `vc-read-revision'.")
-(defun vc-read-revision (prompt &optional files backend default initial-input)
+(defun vc-read-revision (prompt &optional files backend default initial-input
multiple)
+ "Query the user for a revision using PROMPT.
+All subsequent arguments are optional. FILES may specify a file
+set to restrict the revisions to. BACKEND is a VC backend as
+listed in `vc-handled-backends'. DEFAULT and INITIAL-INPUT are
+handled as defined by `completing-read'. If MULTIPLE is non-nil,
+the user may be prompted for multiple revisions. If possible
+this means that `completing-read-multiple' will be used."
(cond
((null files)
(let ((vc-fileset (vc-deduce-fileset t))) ;FIXME: why t? --Stef
@@ -1923,9 +1995,20 @@ Return t if the buffer had changes, nil otherwise."
(completion-table
(vc-call-backend backend 'revision-completion-table files)))
(if completion-table
- (completing-read prompt completion-table
- nil nil initial-input 'vc-revision-history default)
- (read-string prompt initial-input nil default))))
+ (funcall
+ (if multiple #'completing-read-multiple #'completing-read)
+ prompt completion-table nil nil initial-input 'vc-revision-history
default)
+ (let ((answer (read-string prompt initial-input nil default)))
+ (if multiple
+ (split-string answer "[ \t]*,[ \t]*")
+ answer)))))
+
+(defun vc-read-multiple-revisions (prompt &optional files backend default
initial-input)
+ "Query the user for multiple revisions.
+This is equivalent to invoking `vc-read-revision' with t for
+MULTIPLE. The arguments PROMPT, FILES, BACKEND, DEFAULT and
+INITIAL-INPUT are passed on to `vc-read-revision' directly."
+ (vc-read-revision prompt files backend default initial-input t))
(defun vc-diff-build-argument-list-internal (&optional fileset)
"Build argument list for calling internal diff functions."
@@ -3264,6 +3347,132 @@ immediately after this one."
(lambda (&rest args)
(apply #'vc-user-edit-command (apply old args))))))
+;; This is used in .dir-locals.el in the Emacs source tree.
+;;;###autoload (put 'vc-prepare-patches-separately 'safe-local-variable
'booleanp)
+(defcustom vc-prepare-patches-separately t
+ "Whether `vc-prepare-patch' should generate a separate message for each
patch.
+If nil, `vc-prepare-patch' creates a single email message by attaching
+all the patches to the body of that message. If non-nil, each patch
+will be sent out in a separate message, and the messages will be
+prepared sequentially."
+ :type 'boolean
+ :safe #'booleanp
+ :version "29.1")
+
+(defcustom vc-default-patch-addressee nil
+ "Default addressee for `vc-prepare-patch'.
+If nil, no default will be used. This option may be set locally."
+ :type '(choice (const :tag "No default" nil)
+ (string :tag "Addressee"))
+ :safe #'stringp
+ :version "29.1")
+
+(declare-function message--name-table "message" (orig-string))
+(declare-function mml-attach-buffer "mml"
+ (buffer &optional type description disposition))
+(declare-function log-view-get-marked "log-view" ())
+
+(defun vc-default-prepare-patch (_backend rev)
+ (let ((backend (vc-backend buffer-file-name)))
+ (with-current-buffer (generate-new-buffer " *vc-default-prepare-patch*")
+ (vc-diff-internal
+ nil (list backend) rev
+ (vc-call-backend backend 'previous-revision
+ buffer-file-name rev)
+ nil t)
+ (list :subject (concat "Patch for "
+ (file-name-nondirectory
+ (directory-file-name
+ (vc-root-dir))))
+ :buffer (current-buffer)))))
+
+(defun vc-prepare-patch-prompt-revisions ()
+ "Prompt the user for a list revisions.
+Prepare a default value, depending on the current context. With
+a numerical prefix argument, use the last N revisions as the
+default value. If the current buffer is a log-view buffer, use
+the marked commits. Otherwise fall back to the working revision
+of the current file."
+ (vc-read-multiple-revisions
+ "Revisions: " nil nil nil
+ (or (and-let* ((arg current-prefix-arg)
+ (fs (vc-deduce-fileset t)))
+ (cl-loop with file = (caadr fs)
+ repeat (prefix-numeric-value arg)
+ for rev = (vc-working-revision file)
+ then (vc-call-backend
+ (car fs) 'previous-revision
+ file rev)
+ when rev collect it into revs
+ finally return (mapconcat #'identity revs ",")))
+ (and-let* ((revs (log-view-get-marked)))
+ (mapconcat #'identity revs ","))
+ (and-let* ((file (buffer-file-name)))
+ (vc-working-revision file)))))
+
+;;;###autoload
+(defun vc-prepare-patch (addressee subject revisions)
+ "Compose an Email sending patches for REVISIONS to ADDRESSEE.
+If `vc-prepare-patches-separately' is nil, use SUBJECT as the
+default subject for the message, or prompt a subject when invoked
+interactively. Otherwise compose a separate message for each
+revision, with SUBJECT derived from each revision subject.
+When invoked with a numerical prefix argument, use the last N
+revisions.
+When invoked interactively in a Log View buffer with
+marked revisions, use those these."
+ (interactive
+ (let ((revs (vc-prepare-patch-prompt-revisions)) to)
+ (require 'message)
+ (while (null (setq to (completing-read-multiple
+ (format-prompt
+ "Addressee"
+ vc-default-patch-addressee)
+ (message--name-table "")
+ nil nil nil nil
+ vc-default-patch-addressee)))
+ (message "At least one addressee required.")
+ (sit-for blink-matching-delay))
+ (list (string-join to ", ")
+ (and (not vc-prepare-patches-separately)
+ (read-string "Subject: " "[PATCH] " nil nil t))
+ revs)))
+ (save-current-buffer
+ (vc-ensure-vc-buffer)
+ (let ((patches (mapcar (lambda (rev)
+ (vc-call-backend
+ (vc-responsible-backend default-directory)
+ 'prepare-patch rev))
+ revisions)))
+ (if vc-prepare-patches-separately
+ (dolist (patch (reverse patches)
+ (message "Prepared %d patch%s..." (length patches)
+ (if (length> patches 1) "es" "")))
+ (compose-mail addressee
+ (plist-get patch :subject)
+ nil nil nil nil
+ `((kill-buffer ,(plist-get patch :buffer))))
+ (rfc822-goto-eoh) (forward-line)
+ (save-excursion ;don't jump to the end
+ (insert-buffer-substring
+ (plist-get patch :buffer)
+ (plist-get patch :body-start)
+ (plist-get patch :body-end))))
+ (compose-mail addressee subject nil nil nil nil
+ (mapcar
+ (lambda (p)
+ (list #'kill-buffer (plist-get p :buffer)))
+ patches))
+ (rfc822-goto-eoh)
+ (forward-line)
+ (save-excursion
+ (dolist (patch patches)
+ (mml-attach-buffer (buffer-name (plist-get patch :buffer))
+ "text/x-patch"
+ (plist-get patch :subject)
+ "attachment")))
+ (open-line 2)))))
+
(defun vc-default-responsible-p (_backend _file)
"Indicate whether BACKEND is responsible for FILE.
The default is to return nil always."
@@ -3376,6 +3585,41 @@ to provide the `find-revision' operation instead."
(interactive)
(vc-call-backend (vc-backend buffer-file-name) 'check-headers))
+(defun vc-clone (remote &optional backend directory rev)
+ "Use BACKEND to clone REMOTE into DIRECTORY.
+If successful, returns the string with the directory of the
+checkout. If BACKEND is nil, iterate through every known backend
+in `vc-handled-backends' until one succeeds. If REV is non-nil,
+it indicates a specific revision to check out."
+ (unless directory
+ (setq directory default-directory))
+ (if backend
+ (progn
+ (unless (memq backend vc-handled-backends)
+ (error "Unknown VC backend %s" backend))
+ (vc-call-backend backend 'clone remote directory rev))
+ (catch 'ok
+ (dolist (backend vc-handled-backends)
+ (ignore-error vc-not-supported
+ (when-let ((res (vc-call-backend
+ backend 'clone
+ remote directory rev)))
+ (throw 'ok res)))))))
+
+(declare-function log-view-current-tag "log-view" (&optional pos))
+(defun vc-default-last-change (_backend file line)
+ "Default `last-change' implementation.
+It returns the last revision that changed LINE number in FILE."
+ (unless (file-exists-p file)
+ (signal 'file-error "File doesn't exist"))
+ (with-temp-buffer
+ (vc-call-backend (vc-backend file) 'annotate-command
+ file (current-buffer))
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (let ((rev (vc-call annotate-extract-revision-at-line file)))
+ (if (consp rev) (car rev) rev))))
+
;; These things should probably be generally available
diff --git a/lisp/vcursor.el b/lisp/vcursor.el
index e7dd1ba715..896df91983 100644
--- a/lisp/vcursor.el
+++ b/lisp/vcursor.el
@@ -1,7 +1,6 @@
;;; vcursor.el --- manipulate an alternative ("virtual") cursor -*-
lexical-binding: t; -*-
-;; Copyright (C) 1994, 1996, 1998, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1994-2022 Free Software Foundation, Inc.
;; Author: Peter Stephenson <pws@ibmth.df.unipi.it>
;; Maintainer: emacs-devel@gnu.org
@@ -39,7 +38,7 @@
;; off after any operation not involving the vcursor, but the
;; vcursor itself will be left alone.
;; - works on dumb terminals
-;; - new keymap vcursor-map for binding to a prefix key
+;; - new keymap `vcursor-map' for binding to a prefix key
;; - `vcursor-compare-windows' substantially improved
;; - `vcursor-execute-{key,command}' much better about using the
;; right keymaps and arranging for the correct windows to be used
@@ -339,8 +338,6 @@ disable the vcursor."
(cons 'meta key)
key))))
-;; (defvar vcursor)
-
(defun vcursor-bind-keys (var value)
"Alter the value of the variable VAR to VALUE, binding keys as required.
VAR is usually `vcursor-key-bindings'. Normally this function is called
@@ -468,38 +465,36 @@ scrolling set this. It is used by the
`vcursor-auto-disable' code.")
(defvar vcursor-temp-goal-column nil
"Keeps track of temporary goal columns for the virtual cursor.")
-(defvar vcursor-map
- (let ((map (make-sparse-keymap)))
- (define-key map "t" #'vcursor-use-vcursor-map)
-
- (define-key map "\C-p" #'vcursor-previous-line)
- (define-key map "\C-n" #'vcursor-next-line)
- (define-key map "\C-b" #'vcursor-backward-char)
- (define-key map "\C-f" #'vcursor-forward-char)
-
- (define-key map "\r" #'vcursor-disable)
- (define-key map " " #'vcursor-copy)
- (define-key map "\C-y" #'vcursor-copy-word)
- (define-key map "\C-i" #'vcursor-toggle-copy)
- (define-key map "<" #'vcursor-beginning-of-buffer)
- (define-key map ">" #'vcursor-end-of-buffer)
- (define-key map "\M-v" #'vcursor-scroll-down)
- (define-key map "\C-v" #'vcursor-scroll-up)
- (define-key map "o" #'vcursor-other-window)
- (define-key map "g" #'vcursor-goto)
- (define-key map "x" #'vcursor-swap-point)
- (define-key map "\C-s" #'vcursor-isearch-forward)
- (define-key map "\C-r" #'vcursor-isearch-backward)
- (define-key map "\C-a" #'vcursor-beginning-of-line)
- (define-key map "\C-e" #'vcursor-end-of-line)
- (define-key map "\M-w" #'vcursor-forward-word)
- (define-key map "\M-b" #'vcursor-backward-word)
- (define-key map "\M-l" #'vcursor-copy-line)
- (define-key map "c" #'vcursor-compare-windows)
- (define-key map "k" #'vcursor-execute-key)
- (define-key map "\M-x" #'vcursor-execute-command)
- map)
- "Keymap for vcursor command.")
+(defvar-keymap vcursor-map
+ :doc "Keymap for vcursor command."
+ "t" #'vcursor-use-vcursor-map
+
+ "C-p" #'vcursor-previous-line
+ "C-n" #'vcursor-next-line
+ "C-b" #'vcursor-backward-char
+ "C-f" #'vcursor-forward-char
+
+ "RET" #'vcursor-disable
+ "SPC" #'vcursor-copy
+ "C-y" #'vcursor-copy-word
+ "C-i" #'vcursor-toggle-copy
+ "<" #'vcursor-beginning-of-buffer
+ ">" #'vcursor-end-of-buffer
+ "M-v" #'vcursor-scroll-down
+ "C-v" #'vcursor-scroll-up
+ "o" #'vcursor-other-window
+ "g" #'vcursor-goto
+ "x" #'vcursor-swap-point
+ "C-s" #'vcursor-isearch-forward
+ "C-r" #'vcursor-isearch-backward
+ "C-a" #'vcursor-beginning-of-line
+ "C-e" #'vcursor-end-of-line
+ "M-w" #'vcursor-forward-word
+ "M-b" #'vcursor-backward-word
+ "M-l" #'vcursor-copy-line
+ "c" #'vcursor-compare-windows
+ "k" #'vcursor-execute-key
+ "M-x" #'vcursor-execute-command)
;; This seems unused, but it was done as part of define-prefix-command,
;; so let's keep it for now.
(fset 'vcursor-map vcursor-map)
@@ -515,7 +510,6 @@ scrolling set this. It is used by the
`vcursor-auto-disable' code.")
If that's disabled, don't go anywhere but don't complain."
;; This is where we go off-mass-shell. Assume there is a
;; save-excursion to get us back to the pole, er, point.
-
(and (overlayp vcursor-overlay)
(overlay-buffer vcursor-overlay)
(set-buffer (overlay-buffer vcursor-overlay))
@@ -538,7 +532,6 @@ always considered, and the value of `pop-up-frames' is
always respected).
Returns nil if the virtual cursor is not visible anywhere suitable.
Set `vcursor-window' to the returned value as a side effect."
-
;; The order of priorities (respecting NOT-THIS) is (1)
;; vcursor-window if the virtual cursor is visible there (2) any
;; window displaying the virtual cursor (3) vcursor-window provided
@@ -547,7 +540,6 @@ Set `vcursor-window' to the returned value as a side
effect."
;; buffer (5) with NEW-WIN, a window selected by display-buffer (so
;; the variables pop-up-windows and pop-up-frames are significant)
;; (6) nil.
-
(let ((thiswin (selected-window)) winok winbuf)
(save-excursion
(vcursor-locate)
@@ -652,7 +644,6 @@ This is called by most of the virtual-cursor motion
commands."
If the virtual cursor is (or was recently) visible in another window,
switch to that first. Without a prefix ARG, disable the virtual
cursor as well."
-
(interactive "P")
(and (vcursor-find-window) (select-window vcursor-window))
(let ((buf (and vcursor-overlay (overlay-buffer vcursor-overlay))))
@@ -667,7 +658,6 @@ cursor as well."
The virtual cursor window becomes the selected window and the old
window becomes the virtual cursor window. If the virtual cursor would
not be visible otherwise, display it in another window."
-
(interactive)
(let ((buf (current-buffer)) (here (point)) (win (selected-window)))
(vcursor-goto) ; will disable the vcursor
@@ -679,14 +669,12 @@ not be visible otherwise, display it in another window."
(defun vcursor-scroll-up (&optional n)
"Scroll up the vcursor window ARG lines or near full screen if none.
The vcursor will always appear in an unselected window."
-
(interactive "P")
(vcursor-window-funcall #'scroll-up n))
(defun vcursor-scroll-down (&optional n)
"Scroll down the vcursor window ARG lines or near full screen if none.
The vcursor will always appear in an unselected window."
-
(interactive "P")
(vcursor-window-funcall #'scroll-down n))
@@ -694,7 +682,6 @@ The vcursor will always appear in an unselected window."
"Perform forward incremental search in the virtual cursor window.
The virtual cursor is moved to the resulting point; the ordinary
cursor stays where it was."
-
(interactive "P")
(vcursor-window-funcall #'isearch-forward rep norecurs)
)
@@ -703,7 +690,6 @@ cursor stays where it was."
"Perform backward incremental search in the virtual cursor window.
The virtual cursor is moved to the resulting point; the ordinary
cursor stays where it was."
-
(interactive "P")
(vcursor-window-funcall #'isearch-backward rep norecurs)
)
@@ -719,7 +705,6 @@ ARGS. In this case, a new window will not be created if
the vcursor
is visible in the current one."
;; that's to avoid messing up compatibility with old versions
;; by introducing a new argument, which would have to come before ARGS.
-
(vcursor-find-window (not (and (listp func) (vcursor-check t))) t)
(save-excursion
(let ((sw (selected-window)) text)
@@ -751,7 +736,6 @@ is called.
This is called by most of the virtual-cursor copying commands to find
out how much to copy."
-
(vcursor-check)
(with-current-buffer (overlay-buffer vcursor-overlay)
(save-excursion
@@ -792,7 +776,6 @@ active at the same point as the real cursor.
Copying mode is always turned off: the next use of the vcursor will
not copy text until you turn it on again."
-
(interactive "P")
(if (overlayp vcursor-overlay)
(progn
@@ -1078,7 +1061,6 @@ With no argument, copy to the end of the current line.
Behavior with regard to newlines is similar (but not identical) to
`kill-line'; the main difference is that whitespace at the end of the
line is treated like ordinary characters."
-
(interactive "P")
(let* ((num (prefix-numeric-value arg))
(count (vcursor-get-char-count #'end-of-line num)))
diff --git a/lisp/view.el b/lisp/view.el
index 1207f01db2..d9b1a2d0e7 100644
--- a/lisp/view.el
+++ b/lisp/view.el
@@ -68,13 +68,6 @@ the F command in `view-mode', but you can set it to t if you
want the action
for all scroll commands in view mode."
:type 'boolean)
-;;;###autoload
-(defcustom view-remove-frame-by-deleting t
- "Determine how View mode removes a frame no longer needed.
-If nil, make an icon of the frame. If non-nil, delete the frame."
- :type 'boolean
- :version "23.1")
-
(defcustom view-exits-all-viewing-windows nil
"Non-nil means restore all windows used to view buffer.
Commands that restore windows when finished viewing a buffer,
diff --git a/lisp/whitespace.el b/lisp/whitespace.el
index d7b83ef34a..25ea07e9db 100644
--- a/lisp/whitespace.el
+++ b/lisp/whitespace.el
@@ -272,42 +272,40 @@
indentation empty space-after-tab
space-mark tab-mark newline-mark
missing-newline-at-eof)
- "Specify which kind of blank is visualized.
+ "Determine the kinds of whitespace are visualized.
-It's a list containing some or all of the following values:
+The value is a list containing one or more of the following symbols:
- face enable all visualization via faces (see below).
+ face visualize by using faces (see below).
- trailing trailing blanks are visualized via faces.
- It has effect only if `face' (see above)
+ trailing visualize trailing blanks via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- tabs TABs are visualized via faces.
- It has effect only if `face' (see above)
+ tabs visualize TABs via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- spaces SPACEs and HARD SPACEs are visualized via
+ spaces visualize SPACEs and HARD SPACEs via
faces.
- It has effect only if `face' (see above)
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- lines lines which have columns beyond
- `whitespace-line-column' are highlighted via
- faces.
+ lines highlight lines which have columns beyond
+ `whitespace-line-column' via faces.
Whole line is highlighted.
- It has precedence over `lines-tail' and
+ This has precedence over `lines-tail' and
`lines-char' (see below).
- It has effect only if `face' (see above)
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- lines-tail lines which have columns beyond
- `whitespace-line-column' are highlighted via
- faces.
- But only the part of line which goes
- beyond `whitespace-line-column' column.
- It has effect only if `lines' (see above)
- is not present in `whitespace-style'
- and if `face' (see above) is present in
+ lines-tail highlighted lines which have columns beyond
+ `whitespace-line-column' via faces.
+ Only the part of line which goes beyond
+ `whitespace-line-column' column.
+ This has effect only if `lines' (see above)
+ is NOT present in `whitespace-style',
+ and if `face' (see above) IS present in
`whitespace-style'.
lines-char lines which have columns beyond
@@ -319,82 +317,81 @@ It's a list containing some or all of the following
values:
in `whitespace-style' and if `face' (see
above) is present in `whitespace-style'.
- newline NEWLINEs are visualized via faces.
- It has effect only if `face' (see above)
+ newline visualize NEWLINEs via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- missing-newline-at-eof Missing newline at the end of the file is
- visualized via faces.
- It has effect only if `face' (see above)
+ missing-newline-at-eof visualize missing newline at the end of
+ the file via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- empty empty lines at beginning and/or end of buffer
- are visualized via faces.
- It has effect only if `face' (see above)
+ empty visualize empty lines at beginning and/or
+ end of buffer via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- indentation::tab `tab-width' or more SPACEs at beginning of line
- are visualized via faces.
- It has effect only if `face' (see above)
+ indentation::tab visualize `tab-width' or more SPACEs at
+ beginning of line via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- indentation::space TABs at beginning of line are visualized via
+ indentation::space visualize TABs at beginning of line via
faces.
- It has effect only if `face' (see above)
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- indentation `tab-width' or more SPACEs at beginning of line
- are visualized, if `indent-tabs-mode' (which
- see) is non-nil; otherwise, TABs at beginning
- of line are visualized via faces.
- It has effect only if `face' (see above)
+ indentation visualize `tab-width' or more SPACEs at
+ beginning of line, if `indent-tabs-mode' (which
+ see) is non-nil; otherwise, visualize TABs
+ at beginning of line via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- big-indent Big indentations are visualized via faces.
- It has effect only if `face' (see above)
+ big-indent visualize big indentations via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-after-tab::tab `tab-width' or more SPACEs after a TAB
- are visualized via faces.
- It has effect only if `face' (see above)
+ space-after-tab::tab visualize `tab-width' or more SPACEs
+ after a TAB via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-after-tab::space TABs are visualized when `tab-width' or
+ space-after-tab::space visualize TABs when `tab-width' or
more SPACEs occur after a TAB, via
faces.
- It has effect only if `face' (see above)
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-after-tab `tab-width' or more SPACEs after a TAB
- are visualized, if `indent-tabs-mode'
+ space-after-tab visualize `tab-width' or more SPACEs
+ after a TAB, if `indent-tabs-mode'
(which see) is non-nil; otherwise,
- the TABs are visualized via faces.
- It has effect only if `face' (see above)
+ visualize the TABs via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-before-tab::tab SPACEs before TAB are visualized via
- faces.
- It has effect only if `face' (see above)
+ space-before-tab::tab visualize SPACEs before TAB via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-before-tab::space TABs are visualized when SPACEs occur
+ space-before-tab::space visualize TABs when SPACEs occur
before TAB, via faces.
- It has effect only if `face' (see above)
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-before-tab SPACEs before TAB are visualized, if
+ space-before-tab visualize SPACEs before TAB, if
`indent-tabs-mode' (which see) is
- non-nil; otherwise, the TABs are
- visualized via faces.
- It has effect only if `face' (see above)
+ non-nil; otherwise, visualize TABs
+ via faces.
+ This has effect only if `face' (see above)
is present in `whitespace-style'.
- space-mark SPACEs and HARD SPACEs are visualized via
+ space-mark visualize SPACEs and HARD SPACEs via
display table.
- tab-mark TABs are visualized via display table.
+ tab-mark visualize TABs via display table.
- newline-mark NEWLINEs are visualized via display table.
+ newline-mark visualize NEWLINEs via display table.
Any other value is ignored.
@@ -404,8 +401,7 @@ via display table.
There is an evaluation order for some values, if they are
included in `whitespace-style' list. For example, if
indentation, indentation::tab and/or indentation::space are
-included in `whitespace-style' list. The evaluation order for
-these values is:
+included in `whitespace-style' list, the evaluation order is:
* For indentation:
1. indentation
@@ -477,7 +473,9 @@ Used when `whitespace-style' includes the value `spaces'.")
(((class color) (background light))
:background "LightYellow" :foreground "lightgray")
(t :inverse-video t))
- "Face used to visualize SPACE."
+ "Face used to visualize SPACE.
+
+See `whitespace-space-regexp'."
:group 'whitespace)
@@ -492,7 +490,9 @@ Used when `whitespace-style' includes the value `spaces'.")
(((class color) (background light))
:background "LemonChiffon3" :foreground "lightgray")
(t :inverse-video t))
- "Face used to visualize HARD SPACE."
+ "Face used to visualize HARD SPACE.
+
+See `whitespace-hspace-regexp'."
:group 'whitespace)
@@ -508,7 +508,9 @@ Used when `whitespace-style' includes the value `tabs'.")
(((class color) (background light))
:background "beige" :foreground "lightgray")
(t :inverse-video t))
- "Face used to visualize TAB."
+ "Face used to visualize TAB.
+
+See `whitespace-tab-regexp'."
:group 'whitespace)
@@ -542,7 +544,9 @@ Used when `whitespace-style' includes the value
`trailing'.")
'((default :weight bold)
(((class mono)) :inverse-video t :underline t)
(t :background "red1" :foreground "yellow"))
- "Face used to visualize trailing blanks."
+ "Face used to visualize trailing blanks.
+
+See `whitespace-trailing-regexp'."
:group 'whitespace)
@@ -570,7 +574,9 @@ Used when `whitespace-style' includes the value
`space-before-tab'.")
(defface whitespace-space-before-tab
'((((class mono)) :inverse-video t :weight bold :underline t)
(t :background "DarkOrange" :foreground "firebrick"))
- "Face used to visualize SPACEs before TAB."
+ "Face used to visualize SPACEs before TAB.
+
+See `whitespace-space-before-tab-regexp'."
:group 'whitespace)
@@ -582,13 +588,17 @@ Used when `whitespace-style' includes the value
`indentation'.")
(defface whitespace-indentation
'((((class mono)) :inverse-video t :weight bold :underline t)
(t :background "yellow" :foreground "firebrick"))
- "Face used to visualize `tab-width' or more SPACEs at beginning of line."
+ "Face used to visualize `tab-width' or more SPACEs at beginning of line.
+
+See `whitespace-indentation-regexp'."
:group 'whitespace)
(defface whitespace-big-indent
'((((class mono)) :inverse-video t :weight bold :underline t)
(t :background "red" :foreground "firebrick"))
- "Face used to visualize big indentation."
+ "Face used to visualize big indentation.
+
+See `whitespace-big-indent-regexp'."
:group 'whitespace)
(defface whitespace-missing-newline-at-eof
@@ -604,7 +614,9 @@ Used when `whitespace-style' includes the value `empty'.")
(defface whitespace-empty
'((((class mono)) :inverse-video t :weight bold :underline t)
(t :background "yellow" :foreground "firebrick" :extend t))
- "Face used to visualize empty lines at beginning and/or end of buffer."
+ "Face used to visualize empty lines at beginning and/or end of buffer.
+
+See `whitespace-empty-at-bob-regexp' and `whitespace-empty-at-eob-regexp."
:group 'whitespace)
@@ -617,14 +629,17 @@ Used when `whitespace-style' includes the value
`space-after-tab'.")
(defface whitespace-space-after-tab
'((((class mono)) :inverse-video t :weight bold :underline t)
(t :background "yellow" :foreground "firebrick"))
- "Face used to visualize `tab-width' or more SPACEs after TAB."
+ "Face used to visualize `tab-width' or more SPACEs after TAB.
+
+See `whitespace-space-after-tab-regexp'."
:group 'whitespace)
(defcustom whitespace-hspace-regexp
"\\(\u00A0+\\)"
- "Specify HARD SPACE characters regexp.
+ "Regexp to match HARD SPACE characters that should be visualized.
+The HARD SPACE characters are highlighted using the `whitespace-hspace' face.
Here are some examples:
\"\\\\(^\\xA0+\\\\)\" \
@@ -636,19 +651,21 @@ visualize leading and/or trailing HARD SPACEs.
\"\\t\\\\(\\xA0+\\\\)\\t\" \
visualize only HARD SPACEs between TABs.
-NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
+NOTE: Always enclose the elements to highlight in \\\\(...\\\\).
Use exactly one pair of enclosing \\\\( and \\\\).
-Used when `whitespace-style' includes `spaces'."
+This variable is used when `whitespace-style' includes `spaces'."
:type '(regexp :tag "HARD SPACE Chars")
:group 'whitespace)
(defcustom whitespace-space-regexp "\\( +\\)"
- "Specify SPACE characters regexp.
+ "Regexp to match SPACE characters that should be visualized.
-If you're using `mule' package, there may be other characters
-besides \" \" that should be considered SPACE.
+The SPACE characters are highlighted using the `whitespace-space' face.
+By default only ASCII SPACE character is visualized, but if you
+are typing in some non-Latin language, there may be other
+characters besides \" \" that should be considered SPACE.
Here are some examples:
@@ -658,19 +675,21 @@ Here are some examples:
visualize leading and/or trailing SPACEs.
\"\\t\\\\( +\\\\)\\t\" visualize only SPACEs between TABs.
-NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
+NOTE: Always enclose the elements to highlight in \\\\(...\\\\).
Use exactly one pair of enclosing \\\\( and \\\\).
-Used when `whitespace-style' includes `spaces'."
+This variable is used when `whitespace-style' includes `spaces'."
:type '(regexp :tag "SPACE Chars")
:group 'whitespace)
(defcustom whitespace-tab-regexp "\\(\t+\\)"
- "Specify TAB characters regexp.
+ "Regexp to match TAB characters that should be visualized.
-If you're using `mule' package, there may be other characters
-besides \"\\t\" that should be considered TAB.
+The TAB characters are highlighted using the `whitespace-tab' face.
+By default only ASCII TAB character is visualized, but if you
+are typing in some non-Latin language, there may be other
+characters besides \" \" that should be considered a TAB.
Here are some examples:
@@ -680,37 +699,40 @@ Here are some examples:
visualize leading and/or trailing TABs.
\" \\\\(\\t+\\\\) \" visualize only TABs between SPACEs.
-NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
+NOTE: Always enclose the elements to highlight in \\\\(...\\\\).
Use exactly one pair of enclosing \\\\( and \\\\).
-Used when `whitespace-style' includes `tabs'."
+This variable is used when `whitespace-style' includes `tabs'."
:type '(regexp :tag "TAB Chars")
:group 'whitespace)
(defcustom whitespace-trailing-regexp
"\\([\t \u00A0]+\\)$"
- "Specify trailing characters regexp.
+ "Regexp to match trailing characters that should be visualized.
+The trailing characters are highlighted using the `whitespace-trailing' face.
There may be other characters besides:
\" \" \"\\t\" \"\\u00A0\"
that should be considered blank.
-NOTE: Enclose always by \"\\\\(\" and \"\\\\)$\" the elements to highlight.
+NOTE: Always enclose the elements to highlight in \"\\\\(\"...\"\\\\)$\".
Use exactly one pair of enclosing elements above.
-Used when `whitespace-style' includes `trailing'."
+This variable is used when `whitespace-style' includes `trailing'."
:type '(regexp :tag "Trailing Chars")
:group 'whitespace)
(defcustom whitespace-space-before-tab-regexp "\\( +\\)\\(\t+\\)"
- "Specify SPACEs before TAB regexp.
+ "Regexp to match SPACEs before TAB that should be visualized.
-Used when `whitespace-style' includes `space-before-tab',
-`space-before-tab::tab' or `space-before-tab::space'."
+The SPACE characters are highlighted using the `whitespace-space-before-tab'
+face.
+This variable is used when `whitespace-style' includes
+`space-before-tab', `space-before-tab::tab' or `space-before-tab::space'."
:type '(regexp :tag "SPACEs Before TAB")
:group 'whitespace)
@@ -718,12 +740,15 @@ Used when `whitespace-style' includes `space-before-tab',
(defcustom whitespace-indentation-regexp
'("^\t*\\(\\( \\{%d\\}\\)+\\)[^\n\t]"
. "^ *\\(\t+\\)[^\n]")
- "Specify regexp for `tab-width' or more SPACEs at beginning of line.
+ "Regexps to match indentation whitespace that should be visualized.
-It is a cons where the cons car is used for SPACEs visualization
-and the cons cdr is used for TABs visualization.
+The value should be a cons whose car specifies the regexp to match
+visualization of SPACEs, and the cdr specifies the regexp to match
+visualization of TABs.
-Used when `whitespace-style' includes `indentation',
+The indentation characters are highlighted using the `whitespace-indentation'
+face.
+This variable is used when `whitespace-style' includes `indentation',
`indentation::tab' or `indentation::space'."
:type '(cons (string :tag "Indentation SPACEs")
(regexp :tag "Indentation TABs"))
@@ -731,17 +756,19 @@ Used when `whitespace-style' includes `indentation',
(defcustom whitespace-empty-at-bob-regexp "\\`\\([ \t\n]*\\(?:\n\\|$\\)\\)"
- "Specify regexp for empty lines at beginning of buffer.
+ "Regexp to match empty lines at beginning of buffer that should be
visualized.
-Used when `whitespace-style' includes `empty'."
+The empty lines are highlighted using the `whitespace-empty' face.
+This variable is used when `whitespace-style' includes `empty'."
:type '(regexp :tag "Empty Lines At Beginning Of Buffer")
:group 'whitespace)
(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'"
- "Specify regexp for empty lines at end of buffer.
+ "Regexp to match empty lines at end of buffer that should be visualized.
-Used when `whitespace-style' includes `empty'."
+The empty lines are highlighted using the `whitespace-empty' face.
+This variable is used when `whitespace-style' includes `empty'."
:type '(regexp :tag "Empty Lines At End Of Buffer")
:group 'whitespace)
@@ -749,12 +776,16 @@ Used when `whitespace-style' includes `empty'."
(defcustom whitespace-space-after-tab-regexp
'("\t+\\(\\( \\{%d,\\}\\)+\\)"
. "\\(\t+\\) \\{%d,\\}")
- "Specify regexp for `tab-width' or more SPACEs after TAB.
+ "Regexps to match multiple SPACEs after TAB that should be visualized.
-It is a cons where the cons car is used for SPACEs visualization
-and the cons cdr is used for TABs visualization.
+The SPACE and TAB characters will be visualized if there at least
+as many SPACEs as `tab-width' after a TAB.
+The value should be a cons whose car is used for SPACEs visualization
+and whose cdr is used for TABs visualization.
-Used when `whitespace-style' includes `space-after-tab',
+The SPACE characters are highlighted using the `whitespace-space-after-tab'
+face.
+This variable is used when `whitespace-style' includes `space-after-tab',
`space-after-tab::tab' or `space-after-tab::space'."
:type '(cons (string :tag "SPACEs After TAB")
string)
@@ -762,28 +793,33 @@ Used when `whitespace-style' includes `space-after-tab',
(defcustom whitespace-big-indent-regexp
"^\\(\\(?:\t\\{4,\\}\\| \\{32,\\}\\)[\t ]*\\)"
- "Specify big indentation regexp.
+ "Regexp to match big indentation at BOL that should be visualized.
-If you're using `mule' package, there may be other characters
-besides \"\\t\" that should be considered TAB.
+The indentation characters are highlighted using the `whitespace-big-indent'
+face.
+If you're using non-Latin languages, there may be other characters
+besides \"\\t\" that should be considered a TAB.
-NOTE: Enclose always by \\\\( and \\\\) the elements to highlight.
+NOTE: Always enclose the elements to highlight in \\\\(...\\\\).
Use exactly one pair of enclosing \\\\( and \\\\).
-Used when `whitespace-style' includes `big-indent'."
+This variable is used when `whitespace-style' includes `big-indent'."
:version "25.1"
:type '(regexp :tag "Detect too much indentation at the beginning of a line")
:group 'whitespace)
(defcustom whitespace-line-column 80
- "Specify column beyond which the line is highlighted.
+ "Column beyond which the line is highlighted.
+
+The value must be an integer or nil. If nil, use the value
+of the `fill-column' variable.
-It must be an integer or nil. If nil, the `fill-column' variable value is
-used.
+The characters beyond the column specified by this variable are
+highlighted using the `whitespace-line' face.
-Used when `whitespace-style' includes `lines', `lines-tail' or
-`lines-char'."
+This variable is used when `whitespace-style' includes `lines',
+`lines-tail' or `lines-char'."
:type '(choice :tag "Line Length Limit"
(integer :tag "Line Length")
(const :tag "Use fill-column" nil))
@@ -811,7 +847,7 @@ Used when `whitespace-style' includes `lines', `lines-tail'
or
;; If this is a problem for you, please, comment the line below.
(tab-mark ?\t [?» ?\t] [?\\ ?\t]) ; tab - right guillemet
)
- "Specify an alist of mappings for displaying characters.
+ "Alist of mappings for displaying characters.
Each element has the following form:
@@ -831,15 +867,15 @@ KIND is the kind of character.
CHAR is the character to be mapped.
VECTOR is a vector of characters to be displayed in place of CHAR.
- The first display vector that can be displayed is used;
+ The first vector that can be displayed by the terminal is used;
if no display vector for a mapping can be displayed, then
that character is displayed unmodified.
The NEWLINE character is displayed using the face given by
`whitespace-newline' variable.
-Used when `whitespace-style' includes `tab-mark', `space-mark' or
-`newline-mark'."
+This variable is used when `whitespace-style' includes `tab-mark',
+`space-mark' or `newline-mark'."
:type '(repeat
(list :tag "Character Mapping"
(choice :tag "Char Kind"
@@ -861,8 +897,7 @@ Used when `whitespace-style' includes `tab-mark',
`space-mark' or
Global `whitespace-mode' is controlled by the command
`global-whitespace-mode'.
-If nil, means no modes have `whitespace-mode' automatically
-turned on.
+If nil, no modes have `whitespace-mode' automatically turned on.
If t, all modes that support `whitespace-mode' have it
automatically turned on.
@@ -889,16 +924,16 @@ C++ modes only."
(defcustom whitespace-action nil
"Specify which action is taken when a buffer is visited or written.
-It's a list containing some or all of the following values:
+The value is a list containing one or more of the following symbols:
nil no action is taken.
- cleanup cleanup any bogus whitespace always when local
+ cleanup always cleanup any bogus whitespace when local
whitespace is turned on.
See `whitespace-cleanup' and
`whitespace-cleanup-region'.
- report-on-bogus report if there is any bogus whitespace always
+ report-on-bogus always report if there is any bogus whitespace
when local whitespace is turned on.
auto-cleanup cleanup any bogus whitespace when buffer is
@@ -906,8 +941,8 @@ It's a list containing some or all of the following values:
See `whitespace-cleanup' and
`whitespace-cleanup-region'.
- abort-on-bogus abort if there is any bogus whitespace and the
- buffer is written.
+ abort-on-bogus signal an error when writing the buffer if there is
+ any bogus whitespace in the buffer.
warn-if-read-only give a warning if `cleanup' or `auto-cleanup'
is included in `whitespace-action' and the
diff --git a/lisp/window.el b/lisp/window.el
index 905803b19e..dd23ab1d39 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -1,7 +1,6 @@
;;; window.el --- GNU Emacs window commands aside from those written in C -*-
lexical-binding:t -*-
-;; Copyright (C) 1985, 1989, 1992-1994, 2000-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal
@@ -9173,7 +9172,7 @@ present. See also `fit-frame-to-buffer-sizes'."
This list specifies the total maximum and minimum numbers of
lines and the maximum and minimum numbers of columns of the body
of the root window of any frame that shall be fit to its buffer.
-Any value specified by ths variable will be overridden by the
+Any value specified by this variable will be overridden by the
corresponding argument of `fit-frame-to-buffer', if non-nil.
On window systems where the menubar can wrap, fitting a frame to
@@ -10562,27 +10561,25 @@ displaying that processes's buffer."
(define-key ctl-x-4-map "1" 'same-window-prefix)
(define-key ctl-x-4-map "4" 'other-window-prefix)
-(defvar other-window-repeat-map
- (let ((map (make-sparse-keymap)))
- (define-key map "o" 'other-window)
- (define-key map "O" (lambda ()
- (interactive)
- (setq repeat-map 'other-window-repeat-map)
- (other-window -1)))
- map)
- "Keymap to repeat `other-window' key sequences. Used in `repeat-mode'.")
+(defvar-keymap other-window-repeat-map
+ :doc "Keymap to repeat `other-window' key sequences.
+Used in `repeat-mode'."
+ "o" #'other-window
+ "O" (lambda ()
+ (interactive)
+ (setq repeat-map 'other-window-repeat-map)
+ (other-window -1)))
(put 'other-window 'repeat-map 'other-window-repeat-map)
-(defvar resize-window-repeat-map
- (let ((map (make-sparse-keymap)))
- ;; Standard keys:
- (define-key map "^" 'enlarge-window)
- (define-key map "}" 'enlarge-window-horizontally)
- (define-key map "{" 'shrink-window-horizontally)
- ;; Additional keys:
- (define-key map "v" 'shrink-window)
- map)
- "Keymap to repeat window resizing commands. Used in `repeat-mode'.")
+(defvar-keymap resize-window-repeat-map
+ :doc "Keymap to repeat window resizing commands.
+Used in `repeat-mode'."
+ ;; Standard keys:
+ "^" #'enlarge-window
+ "}" #'enlarge-window-horizontally
+ "{" #'shrink-window-horizontally
+ ;; Additional keys:
+ "v" #'shrink-window)
(put 'enlarge-window 'repeat-map 'resize-window-repeat-map)
(put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map)
(put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map)
diff --git a/lisp/winner.el b/lisp/winner.el
index 174b698e7b..c8354b18be 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -328,6 +328,14 @@ You may want to include buffer names such as *Help*,
*Apropos*,
map)
"Keymap for Winner mode.")
+(defvar-keymap winner-repeat-map
+ :doc "Keymap to repeat winner key sequences. Used in `repeat-mode'."
+ "<left>" #'winner-undo
+ "<right>" #'winner-redo)
+
+(put #'winner-undo 'repeat-map 'winner-repeat-map)
+(put #'winner-redo 'repeat-map 'winner-repeat-map)
+
;;;###autoload
(define-minor-mode winner-mode
diff --git a/lisp/woman.el b/lisp/woman.el
index 7f494a3b68..2b456fed3c 100644
--- a/lisp/woman.el
+++ b/lisp/woman.el
@@ -1751,21 +1751,17 @@ Leave point at end of new text. Return length of
inserted text."
;;; Major mode (Man) interface:
-(defvar woman-mode-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map Man-mode-map)
-
- (define-key map "R" #'woman-reformat-last-file)
- (define-key map "w" #'woman)
- (define-key map "\en" #'WoMan-next-manpage)
- (define-key map "\ep" #'WoMan-previous-manpage)
- (define-key map [M-mouse-2] #'woman-follow-word)
-
- ;; We don't need to call `man' when we are in `woman-mode'.
- (define-key map [remap man] #'woman)
- (define-key map [remap man-follow] #'woman-follow)
- map)
- "Keymap for `woman-mode'.")
+(defvar-keymap woman-mode-map
+ :doc "Keymap for `woman-mode'."
+ :parent Man-mode-map
+ "R" #'woman-reformat-last-file
+ "w" #'woman
+ "M-n" #'WoMan-next-manpage
+ "M-p" #'WoMan-previous-manpage
+ "M-<mouse-2>" #'woman-follow-word
+ ;; We don't need to call `man' when we are in `woman-mode'.
+ "<remap> <man>" #'woman
+ "<remap> <man-follow>" #'woman-follow)
(defun woman-follow (topic)
"Get a Un*x manual page of the item under point and put it in a buffer."
diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index 2bda67fe3f..b3465e757a 100644
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -675,7 +675,15 @@ with coordinates relative to the root window."
(defun x-dnd-get-drop-rectangle (window posn)
"Return the drag-and-drop rectangle at POSN on WINDOW."
(if (or dnd-scroll-margin
- (not (windowp window)))
+ (not (windowp window))
+ ;; Drops on the scroll bar aren't allowed, but the mouse
+ ;; rectangle can be set while still on the scroll bar,
+ ;; causing the drag initiator to never send an XdndPosition
+ ;; event that will an XdndStatus message with the accept
+ ;; flag set to be set, even after the mouse enters the
+ ;; window text area. To prevent that, simply don't generate
+ ;; a mouse rectangle when an area is set.
+ (posn-area posn))
'(0 0 0 0)
(let ((window-rectangle (x-dnd-get-window-rectangle window))
object-rectangle)
@@ -810,7 +818,7 @@ has been pressed."
(let ((inhibit-message t))
(funcall function amt))
;; Do not error at buffer limits. Show a message instead.
- ;; This is especially important here because signalling an
+ ;; This is especially important here because signaling an
;; error will mess up the drag-and-drop operation.
(beginning-of-buffer
(message (error-message-string '(beginning-of-buffer))))
@@ -1460,7 +1468,7 @@ instead of returning \"E\".")
(dnd-get-local-file-name local-file-uri))))
(if (not local-name)
'(STRING . "F")
- ;; We want errors to be signalled immediately during ERT
+ ;; We want errors to be signaled immediately during ERT
;; testing, instead of being silently handled. (bug#56712)
(if x-dnd-xds-testing
(prog1 '(STRING . "S")
@@ -1640,8 +1648,9 @@ VERSION is the version of the XDND protocol understood by
SOURCE."
desired-name
(or file-name-coding-system
default-file-name-coding-system)))
- (let ((name (funcall x-dnd-direct-save-function
- t desired-name)))
+ (let ((name (expand-file-name
+ (funcall x-dnd-direct-save-function
+ t desired-name))))
(setq save-to name save-to-remote name))
(when save-to
(if (file-remote-p save-to)
diff --git a/lisp/xwidget.el b/lisp/xwidget.el
index 41a1190c64..7195ba9d89 100644
--- a/lisp/xwidget.el
+++ b/lisp/xwidget.el
@@ -20,15 +20,17 @@
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
-;;
-;; See xwidget.c for more api functions.
+
+;; See the node "(emacs)Embedded WebKit Widgets" in the Emacs manual for
+;; help on user-facing features, and "(elisp)Embedded Native Widgets" in
+;; the Emacs Lisp reference manual for help on more API functions.
+
+;;; Code:
;; This breaks compilation when we don't have xwidgets.
;; And is pointless when we do, since it's in C and so preloaded.
;;(require 'xwidget-internal)
-;;; Code:
-
(require 'cl-lib)
(require 'bookmark)
(require 'format-spec)
@@ -1198,7 +1200,7 @@ Press
\\<xwidget-webkit-isearch-mode-map>\\[xwidget-webkit-isearch-exit] to exit
(xwidget-webkit-goto-history xwidget-webkit-history--session id))
(xwidget-webkit-history-reload))
-(defun xwidget-webkit-history-reload (&rest ignored)
+(defun xwidget-webkit-history-reload (&rest _ignored)
"Reload the current history buffer."
(interactive)
(setq tabulated-list-entries nil)
diff --git a/msdos/autogen/config.in b/msdos/autogen/config.in
index 14782ab4bf..4b1cfb96e8 100644
--- a/msdos/autogen/config.in
+++ b/msdos/autogen/config.in
@@ -217,7 +217,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
whether the gnulib module scanf shall be considered present. */
#undef GNULIB_SCANF
-/* Define if ths system is compatible with GNU/Linux. */
+/* Define if this system is compatible with GNU/Linux. */
#undef GNU_LINUX
/* Define to 1 if you want to use the GNU memory allocator. */
diff --git a/nt/INSTALL b/nt/INSTALL
index 0b8ca98c8a..81d4c6293c 100644
--- a/nt/INSTALL
+++ b/nt/INSTALL
@@ -214,7 +214,7 @@ build will run on Windows 9X and newer systems).
of the 'bsdtar' program to unpack the tarballs. 'bsdtar' is
available as part of the 'libarchive' package from here:
- http://sourceforge.net/projects/ezwinports/files/
+ https://sourceforge.net/projects/ezwinports/files/
The recommended place to install these packages is a single tree
starting from some directory on a drive other than the system drive
@@ -242,16 +242,16 @@ build will run on Windows 9X and newer systems).
. Texinfo (needed to produce the Info manuals when building from
the repository, and for "make install")
- Available from http://sourceforge.net/projects/ezwinports/files/.
+ Available from https://sourceforge.net/projects/ezwinports/files/.
. pkg-config (invoked by the configure script to look for optional
packages)
- Available from http://sourceforge.net/projects/ezwinports/files/.
+ Available from https://sourceforge.net/projects/ezwinports/files/.
. gzip (needed to compress files during "make install")
- Available from http://gnuwin32.sourceforge.net/packages/gzip.htm.
+ Available from https://gnuwin32.sourceforge.net/packages/gzip.htm.
Each package might list other packages as prerequisites on its
download page (under "Runtime requirements"); download those as
@@ -294,7 +294,7 @@ build will run on Windows 9X and newer systems).
. Additional package (needed only if building from the repository):
Autoconf. It is available from here:
-
http://sourceforge.net/projects/ezwinports/files/autoconf-2.65-msys-bin.zip/download
+
https://sourceforge.net/projects/ezwinports/files/autoconf-2.65-msys-bin.zip/download
MSYS packages are distributed as .tar.lzma compressed archives. To
install the packages manually, we recommend to use the Windows port
@@ -642,7 +642,7 @@ build will run on Windows 9X and newer systems).
To support XPM images (required for color tool-bar icons), you will
need the libXpm library. It is available from the ezwinports site,
- http://sourceforge.net/projects/ezwinports/files/ and from
+ https://sourceforge.net/projects/ezwinports/files/ and from
https://ftp.gnu.org/gnu/emacs/windows/.
For PNG images, we recommend to use versions 1.4.x and later of
@@ -665,7 +665,7 @@ build will run on Windows 9X and newer systems).
For GIF images, we recommend to use versions 5.0.0 or later of
giflib, as it is much enhanced wrt previous versions. You can find
precompiled binaries and headers for giflib on the ezwinports site,
- http://sourceforge.net/projects/ezwinports/files/ and on
+ https://sourceforge.net/projects/ezwinports/files/ and on
https://ftp.gnu.org/gnu/emacs/windows/.
Version 5.0.0 and later of giflib are binary incompatible with
@@ -689,7 +689,7 @@ build will run on Windows 9X and newer systems).
Pre-built versions of librsvg and its dependencies can be found
here:
- http://sourceforge.net/projects/ezwinports/files/
+ https://sourceforge.net/projects/ezwinports/files/
This site includes a minimal (as much as possible for librsvg)
build of the library and its dependencies; it is also more
@@ -739,7 +739,7 @@ build will run on Windows 9X and newer systems).
For WebP images you will need libwebp. You can find it here:
- http://sourceforge.net/projects/ezwinports/files/
+ https://sourceforge.net/projects/ezwinports/files/
Note: the MS-Windows binary distribution on the Google site:
@@ -779,7 +779,7 @@ build will run on Windows 9X and newer systems).
session.
You can get pre-built binaries (including any required DLL and the
- header files) at http://sourceforge.net/projects/ezwinports/files/
+ header files) at https://sourceforge.net/projects/ezwinports/files/
and on https://ftp.gnu.org/gnu/emacs/windows/.
* Optional libxml2 support
@@ -801,7 +801,7 @@ build will run on Windows 9X and newer systems).
One place where you can get pre-built Windows binaries of libxml2
(including any required DLL and the header files) is here:
- http://sourceforge.net/projects/ezwinports/files/
+ https://sourceforge.net/projects/ezwinports/files/
https://ftp.gnu.org/gnu/emacs/windows/
For runtime support of libxml2, you will also need to install the
@@ -809,7 +809,7 @@ build will run on Windows 9X and newer systems).
be available to the compiler when you compile with libxml2 support.
A MinGW port of libiconv can be found on the MinGW site:
- http://sourceforge.net/projects/mingw/files/MinGW/Base/libiconv/
+ https://sourceforge.net/projects/mingw/files/MinGW/Base/libiconv/
You need the libiconv-X.Y.Z-N-mingw32-dev.tar.lzma tarball from that
site.
diff --git a/nt/INSTALL.W64 b/nt/INSTALL.W64
index fd8f60bb0b..9261c82db1 100644
--- a/nt/INSTALL.W64
+++ b/nt/INSTALL.W64
@@ -19,7 +19,7 @@ Emacs with the full repository, or less if you're using a
release tarball.
* Set up the MinGW-w64 / MSYS2 build environment
MinGW-w64 provides a complete runtime for projects built with GCC for 64-bit
-Windows -- it's located at http://mingw-w64.org/.
+Windows -- it's located at https://mingw-w64.org/.
MSYS2 is a Cygwin-derived software distribution for Windows which provides
build tools for MinGW-w64 -- see https://msys2.github.io/.
diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h
index 2dd9a9a476..98e31df70c 100644
--- a/nt/inc/ms-w32.h
+++ b/nt/inc/ms-w32.h
@@ -27,7 +27,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <mingw_time.h>
/* MinGW-w64 gcc does not automotically define a macro for
- differentiating it fom MinGW gcc. We need to test the presence of
+ differentiating it from MinGW gcc. We need to test the presence of
__MINGW64_VERSION_MAJOR in _mingw.h: */
#ifdef __MINGW32__
# include <_mingw.h>
diff --git a/oldXMenu/Activate.c b/oldXMenu/Activate.c
index e679c2ffed..781c05bd02 100644
--- a/oldXMenu/Activate.c
+++ b/oldXMenu/Activate.c
@@ -122,7 +122,6 @@ int x_menu_grab_keyboard = 1;
static Wait_func wait_func;
static void* wait_data;
static Translate_func translate_func = NULL;
-static Expose_func expose_func = NULL;
void
XMenuActivateSetWaitFunction (Wait_func func, void *data)
@@ -137,12 +136,6 @@ XMenuActivateSetTranslateFunction (Translate_func func)
translate_func = func;
}
-void
-XMenuActivateSetExposeFunction (Expose_func func)
-{
- expose_func = func;
-}
-
int
XMenuActivate(
register Display *display, /* Display to put menu on. */
@@ -346,9 +339,6 @@ XMenuActivate(
feq = feq_tmp;
}
else if (_XMEventHandler) (*_XMEventHandler)(&event);
-
- if (expose_func)
- expose_func (&event);
break;
}
if (event_xmp->activated) {
diff --git a/oldXMenu/XMenu.h b/oldXMenu/XMenu.h
index 54061235ae..2eee18a384 100644
--- a/oldXMenu/XMenu.h
+++ b/oldXMenu/XMenu.h
@@ -259,7 +259,6 @@ typedef void (*Wait_func)(void*);
XPutBackEvent on an equivalent artificial core event on any
function it wants to translate. */
typedef void (*Translate_func)(XEvent *);
-typedef void (*Expose_func)(XEvent *);
/*
* XMenu library routine declarations.
@@ -281,7 +280,6 @@ int XMenuLocate(Display *display, XMenu *menu, int p_num,
int s_num, int x_pos,
void XMenuSetFreeze(XMenu *menu, int freeze);
void XMenuActivateSetWaitFunction(Wait_func func, void *data);
void XMenuActivateSetTranslateFunction(Translate_func func);
-void XMenuActivateSetExposeFunction(Expose_func func);
int XMenuActivate(Display *display, XMenu *menu, int *p_num, int *s_num, int
x_pos, int y_pos, unsigned int event_mask, char **data, void (*help_callback)
(char const *, int, int));
char *XMenuPost(Display *display, XMenu *menu, int *p_num, int *s_num, int
x_pos, int y_pos, int event_mask);
int XMenuDeletePane(Display *display, XMenu *menu, int p_num);
diff --git a/src/ChangeLog.10 b/src/ChangeLog.10
index ba1cea18d4..1b18ae5ec5 100644
--- a/src/ChangeLog.10
+++ b/src/ChangeLog.10
@@ -7899,7 +7899,7 @@
* buffer.c (scroll-up-aggressively, scroll-down-aggressively):
* keymap.c (Fminor_mode_key_binding):
* macterm.c (mac-emulate-three-button-mouse):
- Delete duplicate duplicate words.
+ Delete duplicate words.
2005-07-18 Ken Raeburn <raeburn@gnu.org>
diff --git a/src/ChangeLog.11 b/src/ChangeLog.11
index 15ab227171..a00ca453ca 100644
--- a/src/ChangeLog.11
+++ b/src/ChangeLog.11
@@ -7503,7 +7503,7 @@
2010-05-28 Kenichi Handa <handa@m17n.org>
* font.c (font_delete_unmatched): Check Vface_ignored_fonts.
- Don't sheck SPEC if it is nil.
+ Don't check SPEC if it is nil.
(font_list_entities): Call font_delete_unmatched if
Vface_ignored_fonts is non-nil. (Bug#6287)
@@ -8639,7 +8639,7 @@
* keyboard.c: QClabel is new.
(parse_tool_bar_item): Take out QClabel from tool bar items.
- Try to construct a label if ther is no QClabel.
+ Try to construct a label if there is no QClabel.
(syms_of_keyboard): Intern :label as QClabel.
* dispextern.h (tool_bar_item_idx): TOOL_BAR_ITEM_LABEL is new.
@@ -11988,7 +11988,7 @@
* cmds.c (nonundocount): New global variable.
(keys_of_cmds): Initialize it.
- (Fself_insert_command): Use it to combine upto 20 sequential chars
+ (Fself_insert_command): Use it to combine up to 20 sequential chars
into a single undo entry, just like the Qself_insert_command code in
keyboard.c does.
Call frame_make_pointer_invisible, also like the Qself_insert_command
diff --git a/src/ChangeLog.12 b/src/ChangeLog.12
index 18618bbfb2..7f77c0ca07 100644
--- a/src/ChangeLog.12
+++ b/src/ChangeLog.12
@@ -73,7 +73,7 @@
* lisp.h (adjust_after_replace): Extern it.
- * coding.c (detect_coding): Cound the heading ASCII bytes in the
+ * coding.c (detect_coding): Count the heading ASCII bytes in the
case of detection for coding_category_utf_8_auto.
(decode_coding_gap) [not CODING_DISABLE_ASCII_OPTIMIZATION]:
Skip decoding if all bytes are ASCII.
@@ -1809,7 +1809,7 @@
* nsfns.m (Fns_do_applescript): Run event loop until script has
been executed (Bug#12969).
- (ns_run_ascript): Chech as_script for nil, set to nil after
+ (ns_run_ascript): Check as_script for nil, set to nil after
executing script.
2012-12-22 Martin Rudalics <rudalics@gmx.at>
@@ -14132,7 +14132,7 @@
(coding_set_destination): Return how many bytes
coding->destination was relocated.
(CODING_DECODE_CHAR, CODING_ENCODE_CHAR, CODING_CHAR_CHARSET)
- (CODING_CHAR_CHARSET_P): Adjust for the avove changes.
+ (CODING_CHAR_CHARSET_P): Adjust for the above changes.
2011-12-05 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny change)
@@ -19967,7 +19967,7 @@
2011-05-05 Eli Zaretskii <eliz@gnu.org>
* w32heap.c (allocate_heap) [USE_LISP_UNION_TYPE || USE_LSB_TAG]:
- New version that can reserve upto 2GB of heap space.
+ New version that can reserve up to 2GB of heap space.
2011-05-05 Chong Yidong <cyd@stupidchicken.com>
diff --git a/src/ChangeLog.13 b/src/ChangeLog.13
index abf2a9421a..91f8005ac5 100644
--- a/src/ChangeLog.13
+++ b/src/ChangeLog.13
@@ -1459,11 +1459,11 @@
(frame_default_tool_bar_height): Extern.
* gtkutil.c (xg_frame_set_char_size): Pass Qxg_frame_set_char_size
to adjust_frame_size.
- * nsfns.m (Fx_create_frame): Pass Pass Qx_create_frame_1 and
+ * nsfns.m (Fx_create_frame): Pass Qx_create_frame_1 and
Qx_create_frame_2 to adjust_frame_size.
* w32fns.c (x_change_tool_bar_height): Call adjust_frame_size with
inhibit 1 when we have not redisplayed the tool bar yet.
- (Fx_create_frame): Pass Pass Qx_create_frame_1 and
+ (Fx_create_frame): Pass Qx_create_frame_1 and
Qx_create_frame_2 to adjust_frame_size.
* w32menu.c (set_frame_menubar): Simplify adjust_frame_size
call.
@@ -1476,7 +1476,7 @@
frame size accordingly.
* xfns.c (x_change_tool_bar_height): Call adjust_frame_size with
inhibit 1 when we have not redisplayed the tool bar yet.
- (Fx_create_frame): Pass Pass Qx_create_frame_1 and
+ (Fx_create_frame): Pass Qx_create_frame_1 and
Qx_create_frame_2 to adjust_frame_size.
2015-01-12 Paul Eggert <eggert@cs.ucla.edu>
@@ -7498,7 +7498,7 @@
2014-04-16 Eli Zaretskii <eliz@gnu.org>
* insdel.c (invalidate_buffer_caches): When deleting or replacing
- text, invalidate the bidi_paragraph_cache upto and including the
+ text, invalidate the bidi_paragraph_cache up to and including the
preceding newline.
2014-04-16 Paul Eggert <eggert@cs.ucla.edu>
@@ -10183,7 +10183,7 @@
(w32_wnd_proc): Handle bottom divider width.
For WM_WINDOWPOSCHANGING return zero if we resize pixelwise.
(Fx_create_frame): Default divider width parameters.
- Caclulate sizes pixelwise. Add vertical drag cursor support.
+ Calculate sizes pixelwise. Add vertical drag cursor support.
(x_create_tip_frame): Default divider widths to zero.
Pixelize call to change_frame_size.
(Fx_show_tip): Add handling of divider widths. Pixelize window
@@ -10868,7 +10868,7 @@
* xdisp.c (syms_of_xdisp): New vars redisplay--all-windows-cause and
redisplay--mode-lines-cause.
- (redisplay_internal): Keep them uptodate. Remove redundant check of
+ (redisplay_internal): Keep them up-to-date. Remove redundant check of
buffer_shared_and_changed.
* *.[chm]: Number every assignment to update_mode_lines so we
can track why it is set.
@@ -11147,7 +11147,7 @@
2013-11-01 Claudio Bley <claudio.bley@googlemail.com>
* image.c (pbm_next_char): New function.
- See http://netpbm.sourceforge.net/doc/pbm.html for the details.
+ See https://netpbm.sourceforge.net/doc/pbm.html for the details.
(pbm_scan_number): Use it.
(Qlibjpeg_version): New variable.
(syms_of_image): DEFSYM and initialize it.
@@ -12566,7 +12566,7 @@
2013-09-16 Dmitry Antipov <dmantipov@yandex.ru>
Do not copy X event in handle_one_xevent except KeyPress case.
- Wnen XEvent is processed, it is unlikely to be changed except
+ When XEvent is processed, it is unlikely to be changed except
KeyPress case, so we can avoid copying and use const pointer to
const data to make sure that an event is not changed elsewhere.
* xterm.c (handle_one_xevent): Change 2nd arg to 'const XEvent *
@@ -14215,7 +14215,7 @@
* w32.c (PEXCEPTION_POINTERS, PEXCEPTION_RECORD, PCONTEXT): Define
variables of these types so that GDB would know about them, as aid
for debugging fatal exceptions. (Bug#15024) See also
- http://sourceware.org/ml/gdb/2013-08/msg00010.html for related
+ https://sourceware.org/ml/gdb/2013-08/msg00010.html for related
discussions.
2013-08-08 Jan Djärv <jan.h.d@swipnet.se>
diff --git a/src/ChangeLog.5 b/src/ChangeLog.5
index c74e44d7a2..408a934ce2 100644
--- a/src/ChangeLog.5
+++ b/src/ChangeLog.5
@@ -2316,7 +2316,7 @@
1995-02-15 Paul Reilly <pmr@geech.gnu.ai.mit.edu>
- * s/dgux.h (LIB_MOTIF): Add -lgen to provide provide the symbols
+ * s/dgux.h (LIB_MOTIF): Add -lgen to provide the symbols
`regcmp' and `regex'.
1995-02-15 Richard Stallman <rms@pogo.gnu.ai.mit.edu>
diff --git a/src/ChangeLog.6 b/src/ChangeLog.6
index fc7cc5e4d4..f5653efd91 100644
--- a/src/ChangeLog.6
+++ b/src/ChangeLog.6
@@ -2225,7 +2225,7 @@
1996-02-08 Eli Zaretskii <eliz@is.elta.co.il>
- * fileio.c (Fmake_temp_name) [MS-DOS]: Allow upto 8 characters in
+ * fileio.c (Fmake_temp_name) [MS-DOS]: Allow up to 8 characters in
the prefix of the temporary file name.
1996-02-07 Richard Stallman <rms@mole.gnu.ai.mit.edu>
diff --git a/src/ChangeLog.7 b/src/ChangeLog.7
index e893a2a6d8..9c6fd810d3 100644
--- a/src/ChangeLog.7
+++ b/src/ChangeLog.7
@@ -1215,19 +1215,19 @@
* ccl.c: Change term translation to code conversion, then change
terms unify/unification to translate/translation respectively
- throughtout the file.
+ throughout the file.
* charset.c: Change terms unify/unification to
- translate/translation respectively throughtout the file.
+ translate/translation respectively throughout the file.
(ONE_BYTE_CHAR_WIDTH): Delete unnecessary continuation line at the
tail.
* charset.h: Change terms unify/unification to
- translate/translation respectively throughtout the file.
+ translate/translation respectively throughout the file.
(GET_TRANSLATION_TABLE): Name changed from UNIFICATION_ID_TABLE.
* coding.c: Change terms unify/unification to
- translate/translation respectively throughtout the file.
+ translate/translation respectively throughout the file.
(encode_coding_iso2022): Fix bug in encoding a text ending by a
composite character.
(check_composing_code): If we are decoding the last block of data,
diff --git a/src/ChangeLog.8 b/src/ChangeLog.8
index ef2472a0f3..c0e3523c64 100644
--- a/src/ChangeLog.8
+++ b/src/ChangeLog.8
@@ -1272,7 +1272,7 @@
* xdisp.c (display_line): Set charpos of first glyph in blank
lines not corresponding to any text to -1, even if no glyphs are
- filled in in that line.
+ filled in on that line.
1999-11-01 Gerd Moellmann <gerd@gnu.org>
@@ -3155,7 +3155,7 @@
* xdisp.c (resize_mini_window): Don't resize if
Vmax_mini_window_height is nil. Otherwise, use a default if
- Vmax_mini_window_height is not ot a number.
+ Vmax_mini_window_height is not a number.
(syms_of_xdisp): Extend documentation of Vmax_mini_window_height.
1999-08-25 Alexandre Oliva <oliva@dcc.unicamp.br>
@@ -5704,7 +5704,7 @@
(x_scroll_bar_expose): Make no-op for toolkit scroll bars.
(x_scroll_bar_create): Create and show a scroll bar widget
if using toolkit scroll bars.
- (x_scroll_bar_move): Handle tookit scroll bars.
+ (x_scroll_bar_move): Handle toolkit scroll bars.
* Makefile.in (LIBW): Use Xaw3d if present.
diff --git a/src/Makefile.in b/src/Makefile.in
index 4ee2843287..da11e130b2 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -429,25 +429,26 @@ ALL_CXX_CFLAGS = $(EMACS_CFLAGS) \
## lastfile must follow all files whose initialized data areas should
## be dumped as pure by dump-emacs.
-base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \
- charset.o coding.o category.o ccl.o character.o chartab.o bidi.o \
- $(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \
- emacs.o keyboard.o macros.o keymap.o sysdep.o \
- bignum.o buffer.o filelock.o insdel.o marker.o \
- minibuf.o fileio.o dired.o \
- cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \
- alloc.o pdumper.o data.o doc.o editfns.o callint.o \
- eval.o floatfns.o fns.o sort.o font.o print.o lread.o $(MODULES_OBJ) \
- syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \
- process.o gnutls.o callproc.o \
- region-cache.o sound.o timefns.o atimer.o \
+base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o
\
+ charset.o coding.o category.o ccl.o character.o chartab.o bidi.o \
+ $(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \
+ emacs.o keyboard.o macros.o keymap.o sysdep.o \
+ bignum.o buffer.o filelock.o insdel.o marker.o \
+ minibuf.o fileio.o dired.o \
+ cmds.o casetab.o casefiddle.o indent.o search.o regex-emacs.o undo.o \
+ alloc.o pdumper.o data.o doc.o editfns.o callint.o \
+ eval.o floatfns.o fns.o sort.o font.o print.o lread.o $(MODULES_OBJ) \
+ syntax.o $(UNEXEC_OBJ) bytecode.o comp.o $(DYNLIB_OBJ) \
+ process.o gnutls.o callproc.o \
+ region-cache.o sound.o timefns.o atimer.o \
doprnt.o intervals.o textprop.o composite.o xml.o lcms.o $(NOTIFY_OBJ) \
- $(XWIDGETS_OBJ) \
- profiler.o decompress.o \
- thread.o systhread.o sqlite.o treesit.o \
- $(if $(HYBRID_MALLOC),sheap.o) \
- $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
- $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \
+ $(XWIDGETS_OBJ) \
+ profiler.o decompress.o \
+ thread.o systhread.o sqlite.o treesit.o \
+ itree.o \
+ $(if $(HYBRID_MALLOC),sheap.o) \
+ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) \
+ $(W32_OBJ) $(WINDOW_SYSTEM_OBJ) $(XGSELOBJ) $(JSON_OBJ) \
$(HAIKU_OBJ) $(PGTK_OBJ)
doc_obj = $(base_obj) $(NS_OBJC_OBJ)
obj = $(doc_obj) $(HAIKU_CXX_OBJ)
@@ -501,7 +502,7 @@ all: ../native-lisp
endif
.PHONY: all
-dmpstruct_headers=$(srcdir)/lisp.h $(srcdir)/buffer.h \
+dmpstruct_headers=$(srcdir)/lisp.h $(srcdir)/buffer.h $(srcdir)/itree.h \
$(srcdir)/intervals.h $(srcdir)/charset.h $(srcdir)/bignum.h
ifeq ($(CHECK_STRUCTS),true)
pdumper.o: dmpstruct.h
diff --git a/src/alloc.c b/src/alloc.c
index 4b6f9b57b3..0653f2e0cc 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1,7 +1,6 @@
/* Storage allocation and gc for GNU Emacs Lisp interpreter.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2022 Free Software
-Foundation, Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -46,6 +45,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "blockinput.h"
#include "pdumper.h"
#include "termhooks.h" /* For struct terminal. */
+#include "itree.h"
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
@@ -3133,6 +3133,11 @@ cleanup_vector (struct Lisp_Vector *vector)
if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BIGNUM))
mpz_clear (PSEUDOVEC_STRUCT (vector, Lisp_Bignum)->value);
+ else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_OVERLAY))
+ {
+ struct Lisp_Overlay *ol = PSEUDOVEC_STRUCT (vector, Lisp_Overlay);
+ xfree (ol->interval);
+ }
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FINALIZER))
unchain_finalizer (PSEUDOVEC_STRUCT (vector, Lisp_Finalizer));
else if (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_FONT))
@@ -3707,18 +3712,20 @@ build_symbol_with_pos (Lisp_Object symbol, Lisp_Object
position)
return val;
}
-/* Return a new overlay with specified START, END and PLIST. */
+/* Return a new (deleted) overlay with PLIST. */
Lisp_Object
-build_overlay (Lisp_Object start, Lisp_Object end, Lisp_Object plist)
+build_overlay (bool front_advance, bool rear_advance,
+ Lisp_Object plist)
{
struct Lisp_Overlay *p = ALLOCATE_PSEUDOVECTOR (struct Lisp_Overlay, plist,
PVEC_OVERLAY);
Lisp_Object overlay = make_lisp_ptr (p, Lisp_Vectorlike);
- OVERLAY_START (overlay) = start;
- OVERLAY_END (overlay) = end;
+ struct itree_node *node = xmalloc (sizeof (*node));
+ itree_node_init (node, front_advance, rear_advance, overlay);
+ p->interval = node;
+ p->buffer = NULL;
set_overlay_plist (overlay, plist);
- p->next = NULL;
return overlay;
}
@@ -5948,8 +5955,7 @@ visit_buffer_root (struct gc_root_visitor visitor,
/* Buffers that are roots don't have intervals, an undo list, or
other constructs that real buffers have. */
eassert (buffer->base_buffer == NULL);
- eassert (buffer->overlays_before == NULL);
- eassert (buffer->overlays_after == NULL);
+ eassert (buffer->overlays == NULL);
/* Visit the buffer-locals. */
visit_vectorlike_root (visitor, (struct Lisp_Vector *) buffer, type);
@@ -6505,16 +6511,25 @@ mark_char_table (struct Lisp_Vector *ptr, enum
pvec_type pvectype)
/* Mark the chain of overlays starting at PTR. */
static void
-mark_overlay (struct Lisp_Overlay *ptr)
+mark_overlay (struct Lisp_Overlay *ov)
{
- for (; ptr && !vectorlike_marked_p (&ptr->header); ptr = ptr->next)
- {
- set_vectorlike_marked (&ptr->header);
- /* These two are always markers and can be marked fast. */
- set_vectorlike_marked (&XMARKER (ptr->start)->header);
- set_vectorlike_marked (&XMARKER (ptr->end)->header);
- mark_object (ptr->plist);
- }
+ /* We don't mark the `itree_node` object, because it is managed manually
+ rather than by the GC. */
+ eassert (BASE_EQ (ov->interval->data, make_lisp_ptr (ov, Lisp_Vectorlike)));
+ set_vectorlike_marked (&ov->header);
+ mark_object (ov->plist);
+}
+
+/* Mark the overlay subtree rooted at NODE. */
+
+static void
+mark_overlays (struct itree_node *node)
+{
+ if (node == NULL)
+ return;
+ mark_object (node->data);
+ mark_overlays (node->left);
+ mark_overlays (node->right);
}
/* Mark Lisp_Objects and special pointers in BUFFER. */
@@ -6538,8 +6553,8 @@ mark_buffer (struct buffer *buffer)
if (!BUFFER_LIVE_P (buffer))
mark_object (BVAR (buffer, undo_list));
- mark_overlay (buffer->overlays_before);
- mark_overlay (buffer->overlays_after);
+ if (buffer->overlays)
+ mark_overlays (buffer->overlays->root);
/* If this is an indirect buffer, mark its base buffer. */
if (buffer->base_buffer &&
@@ -7770,13 +7785,23 @@ allocated since the last garbage collection. All data
types count.
Garbage collection happens automatically only when `eval' is called.
By binding this temporarily to a large number, you can effectively
-prevent garbage collection during a part of the program.
+prevent garbage collection during a part of the program. But be
+sure to get back to the normal value soon enough, to avoid system-wide
+memory pressure, and never use a too-high value for prolonged periods
+of time.
See also `gc-cons-percentage'. */);
DEFVAR_LISP ("gc-cons-percentage", Vgc_cons_percentage,
doc: /* Portion of the heap used for allocation.
Garbage collection can happen automatically once this portion of the heap
has been allocated since the last garbage collection.
+
+By binding this temporarily to a large number, you can effectively
+prevent garbage collection during a part of the program. But be
+sure to get back to the normal value soon enough, to avoid system-wide
+memory pressure, and never use a too-high value for prolonged periods
+of time.
+
If this portion is smaller than `gc-cons-threshold', this is ignored. */);
Vgc_cons_percentage = make_float (0.1);
diff --git a/src/buffer.c b/src/buffer.c
index be7c2f2161..ac7f4f8e9d 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1,7 +1,6 @@
/* Buffer manipulation primitives for GNU Emacs.
-Copyright (C) 1985-1989, 1993-1995, 1997-2022 Free Software Foundation,
-Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -44,6 +43,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "keymap.h"
#include "frame.h"
#include "xwidget.h"
+#include "itree.h"
#include "pdumper.h"
#ifdef WINDOWSNT
@@ -116,7 +116,7 @@ static Lisp_Object QSFundamental; /* A string
"Fundamental". */
static void alloc_buffer_text (struct buffer *, ptrdiff_t);
static void free_buffer_text (struct buffer *b);
-static struct Lisp_Overlay * copy_overlays (struct buffer *, struct
Lisp_Overlay *);
+static void copy_overlays (struct buffer *, struct buffer *);
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);
@@ -645,52 +645,33 @@ even if it is dead. The return value is never nil. */)
return buffer;
}
-
-/* Return a list of overlays which is a copy of the overlay list
- LIST, but for buffer B. */
-
-static struct Lisp_Overlay *
-copy_overlays (struct buffer *b, struct Lisp_Overlay *list)
+static void
+add_buffer_overlay (struct buffer *b, struct Lisp_Overlay *ov,
+ ptrdiff_t begin, ptrdiff_t end)
{
- struct Lisp_Overlay *result = NULL, *tail = NULL;
-
- for (; list; list = list->next)
- {
- Lisp_Object overlay, start, end;
- struct Lisp_Marker *m;
-
- eassert (MARKERP (list->start));
- m = XMARKER (list->start);
- start = build_marker (b, m->charpos, m->bytepos);
- XMARKER (start)->insertion_type = m->insertion_type;
-
- eassert (MARKERP (list->end));
- m = XMARKER (list->end);
- end = build_marker (b, m->charpos, m->bytepos);
- XMARKER (end)->insertion_type = m->insertion_type;
-
- overlay = build_overlay (start, end, Fcopy_sequence (list->plist));
- if (tail)
- tail = tail->next = XOVERLAY (overlay);
- else
- result = tail = XOVERLAY (overlay);
- }
-
- return result;
+ eassert (! ov->buffer);
+ if (! b->overlays)
+ b->overlays = itree_create ();
+ ov->buffer = b;
+ itree_insert (b->overlays, ov->interval, begin, end);
}
-/* Set an appropriate overlay of B. */
+/* Copy overlays of buffer FROM to buffer TO. */
static void
-set_buffer_overlays_before (struct buffer *b, struct Lisp_Overlay *o)
+copy_overlays (struct buffer *from, struct buffer *to)
{
- b->overlays_before = o;
-}
+ eassert (to && ! to->overlays);
+ struct itree_node *node;
-static void
-set_buffer_overlays_after (struct buffer *b, struct Lisp_Overlay *o)
-{
- b->overlays_after = o;
+ ITREE_FOREACH (node, from->overlays, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING)
+ {
+ Lisp_Object ov = node->data;
+ Lisp_Object copy = build_overlay (node->front_advance,
+ node->rear_advance,
+ Fcopy_sequence (OVERLAY_PLIST (ov)));
+ add_buffer_overlay (to, XOVERLAY (copy), node->begin, node->end);
+ }
}
bool
@@ -733,8 +714,7 @@ clone_per_buffer_values (struct buffer *from, struct buffer
*to)
memcpy (to->local_flags, from->local_flags, sizeof to->local_flags);
- set_buffer_overlays_before (to, copy_overlays (to, from->overlays_before));
- set_buffer_overlays_after (to, copy_overlays (to, from->overlays_after));
+ copy_overlays (from, to);
/* Get (a copy of) the alist of Lisp-level local variables of FROM
and install that in TO. */
@@ -933,17 +913,25 @@ does not run the hooks `kill-buffer-hook',
return buf;
}
-/* Mark OV as no longer associated with B. */
+static void
+remove_buffer_overlay (struct buffer *b, struct Lisp_Overlay *ov)
+{
+ eassert (b->overlays);
+ eassert (ov->buffer == b);
+ itree_remove (ov->buffer->overlays, ov->interval);
+ ov->buffer = NULL;
+}
+
+/* Mark OV as no longer associated with its buffer. */
static void
-drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
+drop_overlay (struct Lisp_Overlay *ov)
{
- eassert (b == XBUFFER (Fmarker_buffer (ov->start)));
- modify_overlay (b, marker_position (ov->start),
- marker_position (ov->end));
- unchain_marker (XMARKER (ov->start));
- unchain_marker (XMARKER (ov->end));
+ if (! ov->buffer)
+ return;
+ modify_overlay (ov->buffer, overlay_start (ov), overlay_end (ov));
+ remove_buffer_overlay (ov->buffer, ov);
}
/* Delete all overlays of B and reset its overlay lists. */
@@ -951,26 +939,91 @@ drop_overlay (struct buffer *b, struct Lisp_Overlay *ov)
void
delete_all_overlays (struct buffer *b)
{
- struct Lisp_Overlay *ov, *next;
+ struct itree_node *node;
+
+ if (! b->overlays)
+ return;
- /* FIXME: Since each drop_overlay will scan BUF_MARKERS to unlink its
- markers, we have an unneeded O(N^2) behavior here. */
- for (ov = b->overlays_before; ov; ov = next)
+ /* The general rule is that the tree cannot be modified from within
+ ITREE_FOREACH, but here we bend this rule a little because we know
+ that the POST_ORDER iterator will not need to look at `node` again. */
+ ITREE_FOREACH (node, b->overlays, PTRDIFF_MIN, PTRDIFF_MAX, POST_ORDER)
{
- drop_overlay (b, ov);
- next = ov->next;
- ov->next = NULL;
+ modify_overlay (b, node->begin, node->end);
+ XOVERLAY (node->data)->buffer = NULL;
+ node->parent = NULL;
+ node->left = NULL;
+ node->right = NULL;
}
+ itree_clear (b->overlays);
+}
- for (ov = b->overlays_after; ov; ov = next)
+static void
+free_buffer_overlays (struct buffer *b)
+{
+ /* Actually this does not free any overlay, but the tree only. --ap */
+ if (b->overlays)
{
- drop_overlay (b, ov);
- next = ov->next;
- ov->next = NULL;
+ itree_destroy (b->overlays);
+ b->overlays = NULL;
}
+}
- set_buffer_overlays_before (b, NULL);
- set_buffer_overlays_after (b, NULL);
+/* Adjust the position of overlays in the current buffer according to
+ MULTIBYTE.
+
+ Assume that positions currently correspond to byte positions, if
+ MULTIBYTE is true and to character positions if not.
+*/
+
+static void
+set_overlays_multibyte (bool multibyte)
+{
+ if (! current_buffer->overlays || Z == Z_BYTE)
+ return;
+
+ struct itree_node **nodes = NULL;
+ struct itree_tree *tree = current_buffer->overlays;
+ const intmax_t size = itree_size (tree);
+
+ /* We can't use `itree_node_set_region` at the same time
+ as we iterate over the itree, so we need an auxiliary storage
+ to keep the list of nodes. */
+ USE_SAFE_ALLOCA;
+ SAFE_NALLOCA (nodes, 1, size);
+ {
+ struct itree_node *node, **cursor = nodes;
+ ITREE_FOREACH (node, tree, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING)
+ *(cursor++) = node;
+ }
+
+ for (int i = 0; i < size; ++i, ++nodes)
+ {
+ struct itree_node * const node = *nodes;
+
+ if (multibyte)
+ {
+ ptrdiff_t begin = itree_node_begin (tree, node);
+ ptrdiff_t end = itree_node_end (tree, node);
+
+ /* This models the behavior of markers. (The behavior of
+ text-intervals differs slightly.) */
+ while (begin < Z_BYTE
+ && !CHAR_HEAD_P (FETCH_BYTE (begin)))
+ begin++;
+ while (end < Z_BYTE
+ && !CHAR_HEAD_P (FETCH_BYTE (end)))
+ end++;
+ itree_node_set_region (tree, node, BYTE_TO_CHAR (begin),
+ BYTE_TO_CHAR (end));
+ }
+ else
+ {
+ itree_node_set_region (tree, node, CHAR_TO_BYTE (node->begin),
+ CHAR_TO_BYTE (node->end));
+ }
+ }
+ SAFE_FREE ();
}
/* Reinitialize everything about a buffer except its name and contents
@@ -1000,9 +1053,7 @@ reset_buffer (register struct buffer *b)
b->auto_save_failure_time = 0;
bset_auto_save_file_name (b, Qnil);
bset_read_only (b, Qnil);
- set_buffer_overlays_before (b, NULL);
- set_buffer_overlays_after (b, NULL);
- b->overlay_center = BEG;
+ b->overlays = NULL;
bset_mark_active (b, Qnil);
bset_point_before_scroll (b, Qnil);
bset_file_format (b, Qnil);
@@ -1988,10 +2039,8 @@ cleaning up all windows currently displaying the buffer
to be killed. */)
/* Perhaps we should explicitly free the interval tree here... */
}
- /* Since we've unlinked the markers, the overlays can't be here any more
- either. */
- set_buffer_overlays_before (b, NULL);
- set_buffer_overlays_after (b, NULL);
+ delete_all_overlays (b);
+ free_buffer_overlays (b);
/* Reset the local variables, so that this buffer's local values
won't be protected from GC. They would be protected
@@ -2391,6 +2440,23 @@ advance_to_char_boundary (ptrdiff_t byte_pos)
return byte_pos;
}
+static void
+swap_buffer_overlays (struct buffer *buffer, struct buffer *other)
+{
+ struct itree_node *node;
+
+ ITREE_FOREACH (node, buffer->overlays, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING)
+ XOVERLAY (node->data)->buffer = other;
+
+ ITREE_FOREACH (node, other->overlays, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING)
+ XOVERLAY (node->data)->buffer = buffer;
+
+ /* Swap the interval trees. */
+ void *tmp = buffer->overlays;
+ buffer->overlays = other->overlays;
+ other->overlays = tmp;
+}
+
DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text,
1, 1, 0,
doc: /* Swap the text between current buffer and BUFFER.
@@ -2462,9 +2528,6 @@ results, see Info node `(elisp)Swapping Text'. */)
current_buffer->prevent_redisplay_optimizations_p = 1;
other_buffer->prevent_redisplay_optimizations_p = 1;
swapfield (long_line_optimizations_p, bool_bf);
- swapfield (overlays_before, struct Lisp_Overlay *);
- swapfield (overlays_after, struct Lisp_Overlay *);
- swapfield (overlay_center, ptrdiff_t);
swapfield_ (undo_list, Lisp_Object);
swapfield_ (mark, Lisp_Object);
swapfield_ (mark_active, Lisp_Object); /* Belongs with the `mark'. */
@@ -2491,6 +2554,7 @@ results, see Info node `(elisp)Swapping Text'. */)
current_buffer->text->end_unchanged = current_buffer->text->gpt;
other_buffer->text->beg_unchanged = other_buffer->text->gpt;
other_buffer->text->end_unchanged = other_buffer->text->gpt;
+ swap_buffer_overlays (current_buffer, other_buffer);
{
struct Lisp_Marker *m;
for (m = BUF_MARKERS (current_buffer); m; m = m->next)
@@ -2607,7 +2671,8 @@ current buffer is cleared. */)
/* Do this first, so it can use CHAR_TO_BYTE
to calculate the old correspondences. */
- set_intervals_multibyte (0);
+ set_intervals_multibyte (false);
+ set_overlays_multibyte (false);
bset_enable_multibyte_characters (current_buffer, Qnil);
@@ -2794,7 +2859,8 @@ current buffer is cleared. */)
/* FIXME: Is it worth the trouble, really? Couldn't we just throw
away all the text-properties instead of trying to guess how
to adjust them? AFAICT the result is not reliable anyway. */
- set_intervals_multibyte (1);
+ set_intervals_multibyte (true);
+ set_overlays_multibyte (true);
}
if (!EQ (old_undo, Qt))
@@ -2877,272 +2943,154 @@ the normal hook `change-major-mode-hook'. */)
}
-/* Find all the overlays in the current buffer that contain position POS.
+/* Find all the overlays in the current buffer that overlap the range
+ [BEG, END).
+
+ If EMPTY is true, include empty overlays in that range and also at
+ END, provided END denotes the position at the end of the accessible
+ part of the buffer.
+
+ If TRAILING is true, include overlays that begin at END, provided
+ END denotes the position at the end of the accessible part of the
+ buffer.
+
Return the number found, and store them in a vector in *VEC_PTR.
Store in *LEN_PTR the size allocated for the vector.
Store in *NEXT_PTR the next position after POS where an overlay starts,
- or ZV if there are no more overlays between POS and ZV.
- Store in *PREV_PTR the previous position before POS where an overlay ends,
- or where an overlay starts which ends at or after POS;
- or BEGV if there are no such overlays from BEGV to POS.
- NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
+ or ZV if there are no more overlays.
+ NEXT_PTR may be 0, meaning don't store that info.
*VEC_PTR and *LEN_PTR should contain a valid vector and size
when this function is called.
- If EXTEND, make the vector bigger if necessary.
- If not, never extend the vector,
- and store only as many overlays as will fit.
+ If EXTEND, make the vector bigger if necessary. If not, never
+ extend the vector, and store only as many overlays as will fit.
But still return the total number of overlays.
-
- If CHANGE_REQ, any position written into *PREV_PTR or
- *NEXT_PTR is guaranteed to be not equal to POS, unless it is the
- default (BEGV or ZV). */
+*/
ptrdiff_t
-overlays_at (EMACS_INT pos, bool extend, Lisp_Object **vec_ptr,
- ptrdiff_t *len_ptr,
- ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr, bool change_req)
+overlays_in (ptrdiff_t beg, ptrdiff_t end, bool extend,
+ Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
+ bool empty, bool trailing,
+ ptrdiff_t *next_ptr)
{
ptrdiff_t idx = 0;
ptrdiff_t len = *len_ptr;
- Lisp_Object *vec = *vec_ptr;
ptrdiff_t next = ZV;
- ptrdiff_t prev = BEGV;
- bool inhibit_storing = 0;
-
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object start = OVERLAY_START (overlay);
- Lisp_Object end = OVERLAY_END (overlay);
- ptrdiff_t endpos = OVERLAY_POSITION (end);
- if (endpos < pos)
- {
- if (prev < endpos)
- prev = endpos;
- break;
- }
- ptrdiff_t startpos = OVERLAY_POSITION (start);
- /* This one ends at or after POS
- so its start counts for PREV_PTR if it's before POS. */
- if (prev < startpos && startpos < pos)
- prev = startpos;
- if (endpos == pos)
- continue;
- if (startpos <= pos)
- {
- if (idx == len)
- {
- /* The supplied vector is full.
- Either make it bigger, or don't store any more in it. */
- if (extend)
- {
- vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
- sizeof *vec);
- *vec_ptr = vec;
- len = *len_ptr;
- }
- else
- inhibit_storing = 1;
- }
+ Lisp_Object *vec = *vec_ptr;
+ struct itree_node *node;
- if (!inhibit_storing)
- vec[idx] = overlay;
- /* Keep counting overlays even if we can't return them all. */
- idx++;
- }
- else if (startpos < next)
- next = startpos;
- }
+ /* Extend the search range if overlays beginning at ZV are
+ wanted. */
+ ptrdiff_t search_end = ZV;
+ if (end >= ZV && (empty || trailing))
+ ++search_end;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
+ ITREE_FOREACH (node, current_buffer->overlays, beg, search_end,
+ ASCENDING)
{
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object start = OVERLAY_START (overlay);
- Lisp_Object end = OVERLAY_END (overlay);
- ptrdiff_t startpos = OVERLAY_POSITION (start);
- if (pos < startpos)
- {
- if (startpos < next)
- next = startpos;
- break;
- }
- ptrdiff_t endpos = OVERLAY_POSITION (end);
- if (pos < endpos)
- {
- if (idx == len)
- {
- if (extend)
- {
- vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
- sizeof *vec);
- *vec_ptr = vec;
- len = *len_ptr;
- }
- else
- inhibit_storing = 1;
- }
+ if (node->begin > end)
+ {
+ next = min (next, node->begin);
+ break;
+ }
+ else if (node->begin == end)
+ {
+ next = node->begin;
+ if ((! empty || end < ZV) && beg < end)
+ break;
+ if (empty && node->begin != node->end)
+ continue;
+ }
- if (!inhibit_storing)
- vec[idx] = overlay;
- idx++;
+ if (! empty && node->begin == node->end)
+ continue;
- if (startpos < pos && startpos > prev)
- prev = startpos;
- }
- else if (endpos < pos && endpos > prev)
- prev = endpos;
- else if (endpos == pos && startpos > prev
- && (!change_req || startpos < pos))
- prev = startpos;
+ if (extend && idx == len)
+ {
+ vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
+ sizeof *vec);
+ *vec_ptr = vec;
+ len = *len_ptr;
+ }
+ if (idx < len)
+ vec[idx] = node->data;
+ /* Keep counting overlays even if we can't return them all. */
+ idx++;
}
-
if (next_ptr)
- *next_ptr = next;
- if (prev_ptr)
- *prev_ptr = prev;
+ *next_ptr = next ? next : ZV;
+
return idx;
}
-
-/* Find all the overlays in the current buffer that overlap the range
- BEG-END, or are empty at BEG, or are empty at END provided END
- denotes the position at the end of the current buffer.
- Return the number found, and store them in a vector in *VEC_PTR.
- Store in *LEN_PTR the size allocated for the vector.
- Store in *NEXT_PTR the next position after POS where an overlay starts,
- or ZV if there are no more overlays.
- Store in *PREV_PTR the previous position before POS where an overlay ends,
- or BEGV if there are no previous overlays.
- NEXT_PTR and/or PREV_PTR may be 0, meaning don't store that info.
+/* Find all non-empty overlays in the current buffer that contain
+ position POS.
- *VEC_PTR and *LEN_PTR should contain a valid vector and size
- when this function is called.
+ See overlays_in for the meaning of the arguments.
+ */
- If EXTEND, make the vector bigger if necessary.
- If not, never extend the vector,
- and store only as many overlays as will fit.
- But still return the total number of overlays. */
+ptrdiff_t
+overlays_at (ptrdiff_t pos, bool extend,
+ Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
+ ptrdiff_t *next_ptr)
+{
+ return overlays_in (pos, pos + 1, extend, vec_ptr, len_ptr,
+ false, true, next_ptr);
+}
-static ptrdiff_t
-overlays_in (EMACS_INT beg, EMACS_INT end, bool extend,
- Lisp_Object **vec_ptr, ptrdiff_t *len_ptr,
- ptrdiff_t *next_ptr, ptrdiff_t *prev_ptr)
+ptrdiff_t
+next_overlay_change (ptrdiff_t pos)
{
- ptrdiff_t idx = 0;
- ptrdiff_t len = *len_ptr;
- Lisp_Object *vec = *vec_ptr;
ptrdiff_t next = ZV;
- ptrdiff_t prev = BEGV;
- bool inhibit_storing = 0;
- bool end_is_Z = end == ZV;
+ struct itree_node *node;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
+ ITREE_FOREACH (node, current_buffer->overlays, pos, next, ASCENDING)
{
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object ostart = OVERLAY_START (overlay);
- Lisp_Object oend = OVERLAY_END (overlay);
- ptrdiff_t endpos = OVERLAY_POSITION (oend);
- if (endpos < beg)
- {
- if (prev < endpos)
- prev = endpos;
- break;
- }
- ptrdiff_t startpos = OVERLAY_POSITION (ostart);
- /* Count an interval if it overlaps the range, is empty at the
- start of the range, or is empty at END provided END denotes the
- end of the buffer. */
- if ((beg < endpos && startpos < end)
- || (startpos == endpos
- && (beg == endpos || (end_is_Z && endpos == end))))
- {
- if (idx == len)
- {
- /* The supplied vector is full.
- Either make it bigger, or don't store any more in it. */
- if (extend)
- {
- vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
- sizeof *vec);
- *vec_ptr = vec;
- len = *len_ptr;
- }
- else
- inhibit_storing = 1;
- }
-
- if (!inhibit_storing)
- vec[idx] = overlay;
- /* Keep counting overlays even if we can't return them all. */
- idx++;
- }
- else if (startpos < next)
- next = startpos;
+ if (node->begin > pos)
+ {
+ /* If we reach this branch, node->begin must be the least upper bound
+ of pos, because the search is limited to [pos,next) . */
+ eassert (node->begin < next);
+ next = node->begin;
+ break;
+ }
+ else if (node->begin < node->end && node->end < next)
+ {
+ next = node->end;
+ ITREE_FOREACH_NARROW (pos, next);
+ }
}
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object ostart = OVERLAY_START (overlay);
- Lisp_Object oend = OVERLAY_END (overlay);
- ptrdiff_t startpos = OVERLAY_POSITION (ostart);
- if (end < startpos)
- {
- if (startpos < next)
- next = startpos;
- break;
- }
- ptrdiff_t endpos = OVERLAY_POSITION (oend);
- /* Count an interval if it overlaps the range, is empty at the
- start of the range, or is empty at END provided END denotes the
- end of the buffer. */
- if ((beg < endpos && startpos < end)
- || (startpos == endpos
- && (beg == endpos || (end_is_Z && endpos == end))))
- {
- if (idx == len)
- {
- if (extend)
- {
- vec = xpalloc (vec, len_ptr, 1, OVERLAY_COUNT_MAX,
- sizeof *vec);
- *vec_ptr = vec;
- len = *len_ptr;
- }
- else
- inhibit_storing = 1;
- }
+ return next;
+}
- if (!inhibit_storing)
- vec[idx] = overlay;
- idx++;
- }
- else if (endpos < beg && endpos > prev)
- prev = endpos;
+ptrdiff_t
+previous_overlay_change (ptrdiff_t pos)
+{
+ struct itree_node *node;
+ ptrdiff_t prev = BEGV;
+
+ ITREE_FOREACH (node, current_buffer->overlays, prev, pos, DESCENDING)
+ {
+ if (node->end < pos)
+ prev = node->end;
+ else
+ prev = max (prev, node->begin);
+ ITREE_FOREACH_NARROW (prev, pos);
}
- if (next_ptr)
- *next_ptr = next;
- if (prev_ptr)
- *prev_ptr = prev;
- return idx;
+ return prev;
}
-
/* Return true if there exists an overlay with a non-nil
`mouse-face' property overlapping OVERLAY. */
bool
mouse_face_overlay_overlaps (Lisp_Object overlay)
{
- ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
+ ptrdiff_t start = OVERLAY_START (overlay);
+ ptrdiff_t end = OVERLAY_END (overlay);
ptrdiff_t n, i, size;
Lisp_Object *v, tem;
Lisp_Object vbuf[10];
@@ -3150,11 +3098,11 @@ mouse_face_overlay_overlaps (Lisp_Object overlay)
size = ARRAYELTS (vbuf);
v = vbuf;
- n = overlays_in (start, end, 0, &v, &size, NULL, NULL);
+ n = overlays_in (start, end, 0, &v, &size, true, false, NULL);
if (n > size)
{
SAFE_NALLOCA (v, 1, n);
- overlays_in (start, end, 0, &v, &n, NULL, NULL);
+ overlays_in (start, end, 0, &v, &n, true, false, NULL);
}
for (i = 0; i < n; ++i)
@@ -3179,11 +3127,11 @@ disable_line_numbers_overlay_at_eob (void)
size = ARRAYELTS (vbuf);
v = vbuf;
- n = overlays_in (ZV, ZV, 0, &v, &size, NULL, NULL);
+ n = overlays_in (ZV, ZV, 0, &v, &size, false, false, NULL);
if (n > size)
{
SAFE_NALLOCA (v, 1, n);
- overlays_in (ZV, ZV, 0, &v, &n, NULL, NULL);
+ overlays_in (ZV, ZV, 0, &v, &n, false, false, NULL);
}
for (i = 0; i < n; ++i)
@@ -3196,47 +3144,25 @@ disable_line_numbers_overlay_at_eob (void)
}
-/* Fast function to just test if we're at an overlay boundary. */
+/* Fast function to just test if we're at an overlay boundary.
+
+ Returns true if some overlay starts or ends (or both) at POS,
+*/
bool
overlay_touches_p (ptrdiff_t pos)
{
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
-
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (endpos < pos)
- break;
- if (endpos == pos || OVERLAY_POSITION (OVERLAY_START (overlay)) == pos)
- return 1;
- }
+ struct itree_node *node;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
-
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- if (pos < startpos)
- break;
- if (startpos == pos || OVERLAY_POSITION (OVERLAY_END (overlay)) == pos)
- return 1;
- }
- return 0;
+ /* We need to find overlays ending in pos, as well as empty ones at
+ pos. */
+ ITREE_FOREACH (node, current_buffer->overlays, pos - 1, pos + 1, DESCENDING)
+ if (node->begin == pos || node->end == pos)
+ return true;
+ return false;
}
-
-struct sortvec
-{
- Lisp_Object overlay;
- ptrdiff_t beg, end;
- EMACS_INT priority;
- EMACS_INT spriority; /* Secondary priority. */
-};
-static int
+
+int
compare_overlays (const void *v1, const void *v2)
{
const struct sortvec *s1 = v1;
@@ -3265,6 +3191,33 @@ compare_overlays (const void *v1, const void *v2)
return XLI (s1->overlay) < XLI (s2->overlay) ? -1 : 1;
}
+void
+make_sortvec_item (struct sortvec *item, Lisp_Object overlay)
+{
+ Lisp_Object tem;
+ /* This overlay is good and counts: put it into sortvec. */
+ item->overlay = overlay;
+ item->beg = OVERLAY_START (overlay);
+ item->end = OVERLAY_END (overlay);
+ tem = Foverlay_get (overlay, Qpriority);
+ if (NILP (tem))
+ {
+ item->priority = 0;
+ item->spriority = 0;
+ }
+ else if (FIXNUMP (tem))
+ {
+ item->priority = XFIXNUM (tem);
+ item->spriority = 0;
+ }
+ else if (CONSP (tem))
+ {
+ Lisp_Object car = XCAR (tem);
+ Lisp_Object cdr = XCDR (tem);
+ item->priority = FIXNUMP (car) ? XFIXNUM (car) : 0;
+ item->spriority = FIXNUMP (cdr) ? XFIXNUM (cdr) : 0;
+ }
+}
/* Sort an array of overlays by priority. The array is modified in place.
The return value is the new size; this may be smaller than the original
size if some of the overlays were invalid or were window-specific. */
@@ -3281,47 +3234,18 @@ sort_overlays (Lisp_Object *overlay_vec, ptrdiff_t
noverlays, struct window *w)
for (i = 0, j = 0; i < noverlays; i++)
{
- Lisp_Object tem;
Lisp_Object overlay;
overlay = overlay_vec[i];
if (OVERLAYP (overlay)
- && OVERLAY_POSITION (OVERLAY_START (overlay)) > 0
- && OVERLAY_POSITION (OVERLAY_END (overlay)) > 0)
+ && OVERLAY_START (overlay) > 0
+ && OVERLAY_END (overlay) > 0)
{
- /* If we're interested in a specific window, then ignore
- overlays that are limited to some other window. */
- if (w)
- {
- Lisp_Object window;
-
- window = Foverlay_get (overlay, Qwindow);
- if (WINDOWP (window) && XWINDOW (window) != w)
- continue;
- }
-
- /* This overlay is good and counts: put it into sortvec. */
- sortvec[j].overlay = overlay;
- sortvec[j].beg = OVERLAY_POSITION (OVERLAY_START (overlay));
- sortvec[j].end = OVERLAY_POSITION (OVERLAY_END (overlay));
- tem = Foverlay_get (overlay, Qpriority);
- if (NILP (tem))
- {
- sortvec[j].priority = 0;
- sortvec[j].spriority = 0;
- }
- else if (FIXNUMP (tem))
- {
- sortvec[j].priority = XFIXNUM (tem);
- sortvec[j].spriority = 0;
- }
- else if (CONSP (tem))
- {
- Lisp_Object car = XCAR (tem);
- Lisp_Object cdr = XCDR (tem);
- sortvec[j].priority = FIXNUMP (car) ? XFIXNUM (car) : 0;
- sortvec[j].spriority = FIXNUMP (cdr) ? XFIXNUM (cdr) : 0;
- }
+ /* If we're interested in a specific window, then ignore
+ overlays that are limited to some other window. */
+ if (w && ! overlay_matches_window (w, overlay))
+ continue;
+ make_sortvec_item (sortvec + j, overlay);
j++;
}
}
@@ -3436,25 +3360,27 @@ ptrdiff_t
overlay_strings (ptrdiff_t pos, struct window *w, unsigned char **pstr)
{
bool multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
+ struct itree_node *node;
overlay_heads.used = overlay_heads.bytes = 0;
overlay_tails.used = overlay_tails.bytes = 0;
- for (struct Lisp_Overlay *ov = current_buffer->overlays_before;
- ov; ov = ov->next)
+
+ ITREE_FOREACH (node, current_buffer->overlays, pos - 1, pos + 1, DESCENDING)
{
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
+ Lisp_Object overlay = node->data;
eassert (OVERLAYP (overlay));
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (endpos < pos)
- break;
+ ptrdiff_t startpos = node->begin;
+ ptrdiff_t endpos = node->end;
+
if (endpos != pos && startpos != pos)
continue;
Lisp_Object window = Foverlay_get (overlay, Qwindow);
if (WINDOWP (window) && XWINDOW (window) != w)
continue;
Lisp_Object str;
+ /* FIXME: Are we really sure that `record_overlay_string` can
+ never cause a non-local exit? */
if (startpos == pos
&& (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
record_overlay_string (&overlay_heads, str,
@@ -3469,36 +3395,7 @@ overlay_strings (ptrdiff_t pos, struct window *w,
unsigned char **pstr)
Foverlay_get (overlay, Qpriority),
endpos - startpos);
}
- for (struct Lisp_Overlay *ov = current_buffer->overlays_after;
- ov; ov = ov->next)
- {
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (startpos > pos)
- break;
- if (endpos != pos && startpos != pos)
- continue;
- Lisp_Object window = Foverlay_get (overlay, Qwindow);
- if (WINDOWP (window) && XWINDOW (window) != w)
- continue;
- Lisp_Object str;
- if (startpos == pos
- && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str)))
- record_overlay_string (&overlay_heads, str,
- (startpos == endpos
- ? Foverlay_get (overlay, Qafter_string)
- : Qnil),
- Foverlay_get (overlay, Qpriority),
- endpos - startpos);
- else if (endpos == pos
- && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str)))
- record_overlay_string (&overlay_tails, str, Qnil,
- Foverlay_get (overlay, Qpriority),
- endpos - startpos);
- }
if (overlay_tails.used > 1)
qsort (overlay_tails.buf, overlay_tails.used, sizeof (struct sortstr),
cmp_for_strings);
@@ -3553,384 +3450,71 @@ overlay_strings (ptrdiff_t pos, struct window *w,
unsigned char **pstr)
}
return 0;
}
-
-/* Shift overlays in BUF's overlay lists, to center the lists at POS. */
+
void
-recenter_overlay_lists (struct buffer *buf, ptrdiff_t pos)
+adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length, bool
before_markers)
{
- struct Lisp_Overlay *prev, *next;
-
- /* See if anything in overlays_before should move to overlays_after. */
-
- /* We don't strictly need prev in this loop; it should always be nil.
- But we use it for symmetry and in case that should cease to be true
- with some future change. */
- prev = NULL;
- for (struct Lisp_Overlay *tail = buf->overlays_before;
- tail; prev = tail, tail = next)
- {
- next = tail->next;
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
-
- Lisp_Object beg = OVERLAY_START (overlay);
- Lisp_Object end = OVERLAY_END (overlay);
-
- if (OVERLAY_POSITION (end) > pos)
- {
- /* OVERLAY needs to be moved. */
- ptrdiff_t where = OVERLAY_POSITION (beg);
- struct Lisp_Overlay *other, *other_prev;
-
- /* Splice the cons cell TAIL out of overlays_before. */
- if (prev)
- prev->next = next;
- else
- set_buffer_overlays_before (buf, next);
-
- /* Search thru overlays_after for where to put it. */
- other_prev = NULL;
- for (other = buf->overlays_after; other;
- other_prev = other, other = other->next)
- {
- Lisp_Object otheroverlay = make_lisp_ptr (other, Lisp_Vectorlike);
- eassert (OVERLAYP (otheroverlay));
-
- Lisp_Object otherbeg = OVERLAY_START (otheroverlay);
- if (OVERLAY_POSITION (otherbeg) >= where)
- break;
- }
-
- /* Add TAIL to overlays_after before OTHER. */
- tail->next = other;
- if (other_prev)
- other_prev->next = tail;
- else
- set_buffer_overlays_after (buf, tail);
- tail = prev;
- }
- else
- /* We've reached the things that should stay in overlays_before.
- All the rest of overlays_before must end even earlier,
- so stop now. */
- break;
- }
-
- /* See if anything in overlays_after should be in overlays_before. */
- prev = NULL;
- for (struct Lisp_Overlay *tail = buf->overlays_after;
- tail; prev = tail, tail = next)
+ if (!current_buffer->indirections)
+ itree_insert_gap (current_buffer->overlays, pos, length, before_markers);
+ else
{
- next = tail->next;
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
-
- Lisp_Object beg = OVERLAY_START (overlay);
- Lisp_Object end = OVERLAY_END (overlay);
-
- /* Stop looking, when we know that nothing further
- can possibly end before POS. */
- if (OVERLAY_POSITION (beg) > pos)
- break;
-
- if (OVERLAY_POSITION (end) <= pos)
- {
- /* OVERLAY needs to be moved. */
- ptrdiff_t where = OVERLAY_POSITION (end);
- struct Lisp_Overlay *other, *other_prev;
-
- /* Splice the cons cell TAIL out of overlays_after. */
- if (prev)
- prev->next = next;
- else
- set_buffer_overlays_after (buf, next);
-
- /* Search thru overlays_before for where to put it. */
- other_prev = NULL;
- for (other = buf->overlays_before; other;
- other_prev = other, other = other->next)
- {
- Lisp_Object otheroverlay = make_lisp_ptr (other, Lisp_Vectorlike);
- eassert (OVERLAYP (otheroverlay));
-
- Lisp_Object otherend = OVERLAY_END (otheroverlay);
- if (OVERLAY_POSITION (otherend) <= where)
- break;
- }
-
- /* Add TAIL to overlays_before before OTHER. */
- tail->next = other;
- if (other_prev)
- other_prev->next = tail;
- else
- set_buffer_overlays_before (buf, tail);
- tail = prev;
- }
+ struct buffer *base = current_buffer->base_buffer
+ ? current_buffer->base_buffer
+ : current_buffer;
+ Lisp_Object tail, other;
+ itree_insert_gap (base->overlays, pos, length, before_markers);
+ FOR_EACH_LIVE_BUFFER (tail, other)
+ if (XBUFFER (other)->base_buffer == base)
+ itree_insert_gap (XBUFFER (other)->overlays, pos, length,
+ before_markers);
}
-
- buf->overlay_center = pos;
-}
-
-void
-adjust_overlays_for_insert (ptrdiff_t pos, ptrdiff_t length)
-{
- /* After an insertion, the lists are still sorted properly,
- but we may need to update the value of the overlay center. */
- if (current_buffer->overlay_center >= pos)
- current_buffer->overlay_center += length;
}
-void
-adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
+static void
+adjust_overlays_for_delete_in_buffer (struct buffer * buf,
+ ptrdiff_t pos, ptrdiff_t length)
{
- if (current_buffer->overlay_center < pos)
- /* The deletion was to our right. No change needed; the before- and
- after-lists are still consistent. */
- ;
- else if (current_buffer->overlay_center - pos > length)
- /* The deletion was to our left. We need to adjust the center value
- to account for the change in position, but the lists are consistent
- given the new value. */
- current_buffer->overlay_center -= length;
- else
- /* We're right in the middle. There might be things on the after-list
- that now belong on the before-list. Recentering will move them,
- and also update the center point. */
- recenter_overlay_lists (current_buffer, pos);
-}
-
-/* Fix up overlays that were garbled as a result of permuting markers
- in the range START through END. Any overlay with at least one
- endpoint in this range will need to be unlinked from the overlay
- list and reinserted in its proper place.
- Such an overlay might even have negative size at this point.
- If so, we'll make the overlay empty. */
-void
-fix_start_end_in_overlays (register ptrdiff_t start, register ptrdiff_t end)
-{
- struct Lisp_Overlay *before_list UNINIT;
- struct Lisp_Overlay *after_list UNINIT;
- /* These are either nil, indicating that before_list or after_list
- should be assigned, or the cons cell the cdr of which should be
- assigned. */
- struct Lisp_Overlay *beforep = NULL, *afterp = NULL;
- /* 'Parent', likewise, indicates a cons cell or
- current_buffer->overlays_before or overlays_after, depending
- which loop we're in. */
- struct Lisp_Overlay *parent;
-
- /* This algorithm shifts links around instead of consing and GCing.
- The loop invariant is that before_list (resp. after_list) is a
- well-formed list except that its last element, the CDR of beforep
- (resp. afterp) if beforep (afterp) isn't nil or before_list
- (after_list) if it is, is still uninitialized. So it's not a bug
- that before_list isn't initialized, although it may look
- strange. */
- parent = NULL;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
-
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
-
- /* If the overlay is backwards, make it empty. */
- if (endpos < startpos)
- {
- startpos = endpos;
- Fset_marker (OVERLAY_START (overlay), make_fixnum (startpos),
- Qnil);
- }
-
- if (endpos < start)
- break;
-
- if (endpos < end
- || (startpos >= start && startpos < end))
- {
- /* Add it to the end of the wrong list. Later on,
- recenter_overlay_lists will move it to the right place. */
- if (endpos < current_buffer->overlay_center)
- {
- if (!afterp)
- after_list = tail;
- else
- afterp->next = tail;
- afterp = tail;
- }
- else
- {
- if (!beforep)
- before_list = tail;
- else
- beforep->next = tail;
- beforep = tail;
- }
- if (!parent)
- set_buffer_overlays_before (current_buffer, tail->next);
- else
- parent->next = tail->next;
- }
- else
- parent = tail;
- }
- parent = NULL;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
-
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- /* If the overlay is backwards, make it empty. */
- if (endpos < startpos)
- {
- startpos = endpos;
- Fset_marker (OVERLAY_START (overlay), make_fixnum (startpos),
- Qnil);
- }
+ Lisp_Object hit_list = Qnil;
+ struct itree_node *node;
- if (startpos >= end)
- break;
+ /* Ideally, the evaporate check would be done directly within
+ `itree_delete_gap`, but that code isn't supposed to know about overlays,
+ only about `itree_node`s, so it would break an abstraction boundary. */
+ itree_delete_gap (buf->overlays, pos, length);
- if (startpos >= start
- || (endpos >= start && endpos < end))
- {
- if (endpos < current_buffer->overlay_center)
- {
- if (!afterp)
- after_list = tail;
- else
- afterp->next = tail;
- afterp = tail;
- }
- else
- {
- if (!beforep)
- before_list = tail;
- else
- beforep->next = tail;
- beforep = tail;
- }
- if (!parent)
- set_buffer_overlays_after (current_buffer, tail->next);
- else
- parent->next = tail->next;
- }
- else
- parent = tail;
- }
+ /* Delete any zero-sized overlays at position POS, if the `evaporate'
+ property is set. */
- /* Splice the constructed (wrong) lists into the buffer's lists,
- and let the recenter function make it sane again. */
- if (beforep)
+ ITREE_FOREACH (node, buf->overlays, pos, pos, ASCENDING)
{
- beforep->next = current_buffer->overlays_before;
- set_buffer_overlays_before (current_buffer, before_list);
+ if (node->end == pos && node->begin == pos
+ && ! NILP (Foverlay_get (node->data, Qevaporate)))
+ hit_list = Fcons (node->data, hit_list);
}
- if (afterp)
- {
- afterp->next = current_buffer->overlays_after;
- set_buffer_overlays_after (current_buffer, after_list);
- }
- recenter_overlay_lists (current_buffer, current_buffer->overlay_center);
+ for (; CONSP (hit_list); hit_list = XCDR (hit_list))
+ Fdelete_overlay (XCAR (hit_list));
}
-/* We have two types of overlay: the one whose ending marker is
- after-insertion-marker (this is the usual case) and the one whose
- ending marker is before-insertion-marker. When `overlays_before'
- contains overlays of the latter type and the former type in this
- order and both overlays end at inserting position, inserting a text
- increases only the ending marker of the latter type, which results
- in incorrect ordering of `overlays_before'.
-
- This function fixes ordering of overlays in the slot
- `overlays_before' of the buffer *BP. Before the insertion, `point'
- was at PREV, and now is at POS. */
-
void
-fix_overlays_before (struct buffer *bp, ptrdiff_t prev, ptrdiff_t pos)
+adjust_overlays_for_delete (ptrdiff_t pos, ptrdiff_t length)
{
- /* If parent is nil, replace overlays_before; otherwise, parent->next. */
- struct Lisp_Overlay *tail = bp->overlays_before, *parent = NULL, *right_pair;
- Lisp_Object tem;
- ptrdiff_t end UNINIT;
-
- /* After the insertion, the several overlays may be in incorrect
- order. The possibility is that, in the list `overlays_before',
- an overlay which ends at POS appears after an overlay which ends
- at PREV. Since POS is greater than PREV, we must fix the
- ordering of these overlays, by moving overlays ends at POS before
- the overlays ends at PREV. */
-
- /* At first, find a place where disordered overlays should be linked
- in. It is where an overlay which end before POS exists. (i.e. an
- overlay whose ending marker is after-insertion-marker if disorder
- exists). */
- while (tail
- && (tem = make_lisp_ptr (tail, Lisp_Vectorlike),
- (end = OVERLAY_POSITION (OVERLAY_END (tem))) >= pos))
- {
- parent = tail;
- tail = tail->next;
- }
-
- /* If we don't find such an overlay,
- or the found one ends before PREV,
- or the found one is the last one in the list,
- we don't have to fix anything. */
- if (!tail)
- return;
- if (end < prev || !tail->next)
- return;
-
- right_pair = parent;
- parent = tail;
- tail = tail->next;
-
- /* Now, end position of overlays in the list TAIL should be before
- or equal to PREV. In the loop, an overlay which ends at POS is
- moved ahead to the place indicated by the CDR of RIGHT_PAIR. If
- we found an overlay which ends before PREV, the remaining
- overlays are in correct order. */
- while (tail)
+ if (!current_buffer->indirections)
+ adjust_overlays_for_delete_in_buffer (current_buffer, pos, length);
+ else
{
- tem = make_lisp_ptr (tail, Lisp_Vectorlike);
- end = OVERLAY_POSITION (OVERLAY_END (tem));
-
- if (end == pos)
- { /* This overlay is disordered. */
- struct Lisp_Overlay *found = tail;
-
- /* Unlink the found overlay. */
- tail = found->next;
- parent->next = tail;
- /* Move an overlay at RIGHT_PLACE to the next of the found one,
- and link it into the right place. */
- if (!right_pair)
- {
- found->next = bp->overlays_before;
- set_buffer_overlays_before (bp, found);
- }
- else
- {
- found->next = right_pair->next;
- right_pair->next = found;
- }
- }
- else if (end == prev)
- {
- parent = tail;
- tail = tail->next;
- }
- else /* No more disordered overlay. */
- break;
+ struct buffer *base = current_buffer->base_buffer
+ ? current_buffer->base_buffer
+ : current_buffer;
+ Lisp_Object tail, other;
+ adjust_overlays_for_delete_in_buffer (base, pos, length);
+ FOR_EACH_LIVE_BUFFER (tail, other)
+ if (XBUFFER (other)->base_buffer == base)
+ adjust_overlays_for_delete_in_buffer (XBUFFER (other), pos, length);
}
}
+
DEFUN ("overlayp", Foverlayp, Soverlayp, 1, 1, 0,
doc: /* Return t if OBJECT is an overlay. */)
@@ -3952,7 +3536,7 @@ for the rear of the overlay advance when text is inserted
there
(Lisp_Object beg, Lisp_Object end, Lisp_Object buffer,
Lisp_Object front_advance, Lisp_Object rear_advance)
{
- Lisp_Object overlay;
+ Lisp_Object ov;
struct buffer *b;
if (NILP (buffer))
@@ -3960,6 +3544,10 @@ for the rear of the overlay advance when text is
inserted there
else
CHECK_BUFFER (buffer);
+ b = XBUFFER (buffer);
+ if (! BUFFER_LIVE_P (b))
+ error ("Attempt to create overlay in a dead buffer");
+
if (MARKERP (beg) && !BASE_EQ (Fmarker_buffer (beg), buffer))
signal_error ("Marker points into wrong buffer", beg);
if (MARKERP (end) && !BASE_EQ (Fmarker_buffer (end), buffer))
@@ -3974,39 +3562,16 @@ for the rear of the overlay advance when text is
inserted there
temp = beg; beg = end; end = temp;
}
- b = XBUFFER (buffer);
-
- beg = Fset_marker (Fmake_marker (), beg, buffer);
- end = Fset_marker (Fmake_marker (), end, buffer);
-
- if (!NILP (front_advance))
- XMARKER (beg)->insertion_type = 1;
- if (!NILP (rear_advance))
- XMARKER (end)->insertion_type = 1;
-
- overlay = build_overlay (beg, end, Qnil);
-
- /* Put the new overlay on the wrong list. */
- end = OVERLAY_END (overlay);
- if (OVERLAY_POSITION (end) < b->overlay_center)
- {
- eassert (b->overlays_after || (XOVERLAY (overlay)->next == NULL));
- XOVERLAY (overlay)->next = b->overlays_after;
- set_buffer_overlays_after (b, XOVERLAY (overlay));
- }
- else
- {
- eassert (b->overlays_before || (XOVERLAY (overlay)->next == NULL));
- XOVERLAY (overlay)->next = b->overlays_before;
- set_buffer_overlays_before (b, XOVERLAY (overlay));
- }
- /* This puts it in the right list, and in the right order. */
- recenter_overlay_lists (b, b->overlay_center);
+ ptrdiff_t obeg = clip_to_bounds (BUF_BEG (b), XFIXNUM (beg), BUF_Z (b));
+ ptrdiff_t oend = clip_to_bounds (obeg, XFIXNUM (end), BUF_Z (b));
+ ov = build_overlay (! NILP (front_advance),
+ ! NILP (rear_advance), Qnil);
+ add_buffer_overlay (b, XOVERLAY (ov), obeg, oend);
/* We don't need to redisplay the region covered by the overlay, because
the overlay has no properties at the moment. */
- return overlay;
+ return ov;
}
/* Mark a section of BUF as needing redisplay because of overlays changes. */
@@ -4028,35 +3593,6 @@ modify_overlay (struct buffer *buf, ptrdiff_t start,
ptrdiff_t end)
modiff_incr (&BUF_OVERLAY_MODIFF (buf), 1);
}
-/* Remove OVERLAY from LIST. */
-
-static struct Lisp_Overlay *
-unchain_overlay (struct Lisp_Overlay *list, struct Lisp_Overlay *overlay)
-{
- register struct Lisp_Overlay *tail, **prev = &list;
-
- for (tail = list; tail; prev = &tail->next, tail = *prev)
- if (tail == overlay)
- {
- *prev = overlay->next;
- overlay->next = NULL;
- break;
- }
- return list;
-}
-
-/* Remove OVERLAY from both overlay lists of B. */
-
-static void
-unchain_both (struct buffer *b, Lisp_Object overlay)
-{
- struct Lisp_Overlay *ov = XOVERLAY (overlay);
-
- set_buffer_overlays_before (b, unchain_overlay (b->overlays_before, ov));
- set_buffer_overlays_after (b, unchain_overlay (b->overlays_after, ov));
- eassert (XOVERLAY (overlay)->next == NULL);
-}
-
DEFUN ("move-overlay", Fmove_overlay, Smove_overlay, 3, 4, 0,
doc: /* Set the endpoints of OVERLAY to BEG and END in BUFFER.
If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now.
@@ -4067,12 +3603,11 @@ buffer. */)
struct buffer *b, *ob = 0;
Lisp_Object obuffer;
specpdl_ref count = SPECPDL_INDEX ();
- ptrdiff_t n_beg, n_end;
ptrdiff_t o_beg UNINIT, o_end UNINIT;
CHECK_OVERLAY (overlay);
if (NILP (buffer))
- buffer = Fmarker_buffer (OVERLAY_START (overlay));
+ buffer = Foverlay_buffer (overlay);
if (NILP (buffer))
XSETBUFFER (buffer, current_buffer);
CHECK_BUFFER (buffer);
@@ -4094,37 +3629,31 @@ buffer. */)
temp = beg; beg = end; end = temp;
}
- specbind (Qinhibit_quit, Qt);
+ specbind (Qinhibit_quit, Qt); /* FIXME: Why? */
- obuffer = Fmarker_buffer (OVERLAY_START (overlay));
+ obuffer = Foverlay_buffer (overlay);
b = XBUFFER (buffer);
+ ptrdiff_t n_beg = clip_to_bounds (BUF_BEG (b), XFIXNUM (beg), BUF_Z (b));
+ ptrdiff_t n_end = clip_to_bounds (n_beg, XFIXNUM (end), BUF_Z (b));
+
if (!NILP (obuffer))
{
ob = XBUFFER (obuffer);
- o_beg = OVERLAY_POSITION (OVERLAY_START (overlay));
- o_end = OVERLAY_POSITION (OVERLAY_END (overlay));
+ o_beg = OVERLAY_START (overlay);
+ o_end = OVERLAY_END (overlay);
+ }
- unchain_both (ob, overlay);
+ if (! BASE_EQ (buffer, obuffer))
+ {
+ if (! NILP (obuffer))
+ remove_buffer_overlay (XBUFFER (obuffer), XOVERLAY (overlay));
+ add_buffer_overlay (XBUFFER (buffer), XOVERLAY (overlay), n_beg, n_end);
}
else
- /* An overlay not associated with any buffer will normally have its
- `next' field set to NULL, but not always: when killing a buffer,
- we just set its overlays_after and overlays_before to NULL without
- manually setting each overlay's `next' field to NULL.
- Let's correct it here, to simplify subsequent assertions.
- FIXME: Maybe the better fix is to change `kill-buffer'!? */
- XOVERLAY (overlay)->next = NULL;
-
- eassert (XOVERLAY (overlay)->next == NULL);
-
- /* Set the overlay boundaries, which may clip them. */
- Fset_marker (OVERLAY_START (overlay), beg, buffer);
- Fset_marker (OVERLAY_END (overlay), end, buffer);
-
- n_beg = marker_position (OVERLAY_START (overlay));
- n_end = marker_position (OVERLAY_END (overlay));
+ itree_node_set_region (b->overlays, XOVERLAY (overlay)->interval,
+ n_beg, n_end);
/* If the overlay has changed buffers, do a thorough redisplay. */
if (!BASE_EQ (buffer, obuffer))
@@ -4147,8 +3676,6 @@ buffer. */)
modify_overlay (b, min (o_beg, n_beg), max (o_end, n_end));
}
- eassert (XOVERLAY (overlay)->next == NULL);
-
/* Delete the overlay if it is empty after clipping and has the
evaporate property. */
if (n_beg == n_end && !NILP (Foverlay_get (overlay, Qevaporate)))
@@ -4158,26 +3685,10 @@ buffer. */)
contrary to `Fdelete_overlay's assumptions.
- Most of the work done by Fdelete_overlay has already been done
here for other reasons. */
- drop_overlay (XBUFFER (buffer), XOVERLAY (overlay));
+ drop_overlay (XOVERLAY (overlay));
return unbind_to (count, overlay);
}
- /* Put the overlay into the new buffer's overlay lists, first on the
- wrong list. */
- if (n_end < b->overlay_center)
- {
- XOVERLAY (overlay)->next = b->overlays_after;
- set_buffer_overlays_after (b, XOVERLAY (overlay));
- }
- else
- {
- XOVERLAY (overlay)->next = b->overlays_before;
- set_buffer_overlays_before (b, XOVERLAY (overlay));
- }
-
- /* This puts it in the right list, and in the right order. */
- recenter_overlay_lists (b, b->overlay_center);
-
return unbind_to (count, overlay);
}
@@ -4185,21 +3696,18 @@ DEFUN ("delete-overlay", Fdelete_overlay,
Sdelete_overlay, 1, 1, 0,
doc: /* Delete the overlay OVERLAY from its buffer. */)
(Lisp_Object overlay)
{
- Lisp_Object buffer;
struct buffer *b;
specpdl_ref count = SPECPDL_INDEX ();
CHECK_OVERLAY (overlay);
- buffer = Fmarker_buffer (OVERLAY_START (overlay));
- if (NILP (buffer))
+ b = OVERLAY_BUFFER (overlay);
+ if (! b)
return Qnil;
- b = XBUFFER (buffer);
specbind (Qinhibit_quit, Qt);
- unchain_both (b, overlay);
- drop_overlay (b, XOVERLAY (overlay));
+ drop_overlay (XOVERLAY (overlay));
/* When deleting an overlay with before or after strings, turn off
display optimizations for the affected buffer, on the basis that
@@ -4230,8 +3738,10 @@ DEFUN ("overlay-start", Foverlay_start, Soverlay_start,
1, 1, 0,
(Lisp_Object overlay)
{
CHECK_OVERLAY (overlay);
+ if (! OVERLAY_BUFFER (overlay))
+ return Qnil;
- return (Fmarker_position (OVERLAY_START (overlay)));
+ return make_fixnum (OVERLAY_START (overlay));
}
DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1, 0,
@@ -4239,8 +3749,10 @@ DEFUN ("overlay-end", Foverlay_end, Soverlay_end, 1, 1,
0,
(Lisp_Object overlay)
{
CHECK_OVERLAY (overlay);
+ if (! OVERLAY_BUFFER (overlay))
+ return Qnil;
- return (Fmarker_position (OVERLAY_END (overlay)));
+ return make_fixnum (OVERLAY_END (overlay));
}
DEFUN ("overlay-buffer", Foverlay_buffer, Soverlay_buffer, 1, 1, 0,
@@ -4248,9 +3760,16 @@ DEFUN ("overlay-buffer", Foverlay_buffer,
Soverlay_buffer, 1, 1, 0,
Return nil if OVERLAY has been deleted. */)
(Lisp_Object overlay)
{
+ Lisp_Object buffer;
+
CHECK_OVERLAY (overlay);
- return Fmarker_buffer (OVERLAY_START (overlay));
+ if (! OVERLAY_BUFFER (overlay))
+ return Qnil;
+
+ XSETBUFFER (buffer, OVERLAY_BUFFER (overlay));
+
+ return buffer;
}
DEFUN ("overlay-properties", Foverlay_properties, Soverlay_properties, 1, 1, 0,
@@ -4261,7 +3780,7 @@ OVERLAY. */)
{
CHECK_OVERLAY (overlay);
- return Fcopy_sequence (XOVERLAY (overlay)->plist);
+ return Fcopy_sequence (OVERLAY_PLIST (overlay));
}
@@ -4289,8 +3808,7 @@ interest. */)
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len. */
- noverlays = overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len,
- NULL, NULL, 0);
+ noverlays = overlays_at (XFIXNUM (pos), true, &overlay_vec, &len, NULL);
if (!NILP (sorted))
noverlays = sort_overlays (overlay_vec, noverlays,
@@ -4316,7 +3834,9 @@ and also contained within the specified region.
Empty overlays are included in the result if they are located at BEG,
between BEG and END, or at END provided END denotes the position at the
-end of the accessible part of the buffer. */)
+end of the accessible part of the buffer.
+
+The resulting list of overlays is in an arbitrary unpredictable order. */)
(Lisp_Object beg, Lisp_Object end)
{
ptrdiff_t len, noverlays;
@@ -4335,7 +3855,7 @@ end of the accessible part of the buffer. */)
/* Put all the overlays we want in a vector in overlay_vec.
Store the length in len. */
noverlays = overlays_in (XFIXNUM (beg), XFIXNUM (end), 1, &overlay_vec, &len,
- NULL, NULL);
+ true, false, NULL);
/* Make a list of them all. */
result = Flist (noverlays, overlay_vec);
@@ -4351,39 +3871,12 @@ If there are no overlay boundaries from POS to
(point-max),
the value is (point-max). */)
(Lisp_Object pos)
{
- ptrdiff_t i, len, noverlays;
- ptrdiff_t endpos;
- Lisp_Object *overlay_vec;
-
CHECK_FIXNUM_COERCE_MARKER (pos);
if (!buffer_has_overlays ())
return make_fixnum (ZV);
- len = 10;
- overlay_vec = xmalloc (len * sizeof *overlay_vec);
-
- /* Put all the overlays we want in a vector in overlay_vec.
- Store the length in len.
- endpos gets the position where the next overlay starts. */
- noverlays = overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len,
- &endpos, 0, 1);
-
- /* If any of these overlays ends before endpos,
- use its ending point instead. */
- for (i = 0; i < noverlays; i++)
- {
- Lisp_Object oend;
- ptrdiff_t oendpos;
-
- oend = OVERLAY_END (overlay_vec[i]);
- oendpos = OVERLAY_POSITION (oend);
- if (oendpos < endpos)
- endpos = oendpos;
- }
-
- xfree (overlay_vec);
- return make_fixnum (endpos);
+ return make_fixnum (next_overlay_change (XFIXNUM (pos)));
}
DEFUN ("previous-overlay-change", Fprevious_overlay_change,
@@ -4393,32 +3886,15 @@ If there are no overlay boundaries from (point-min) to
POS,
the value is (point-min). */)
(Lisp_Object pos)
{
- ptrdiff_t prevpos;
- Lisp_Object *overlay_vec;
- ptrdiff_t len;
CHECK_FIXNUM_COERCE_MARKER (pos);
if (!buffer_has_overlays ())
return make_fixnum (BEGV);
- /* At beginning of buffer, we know the answer;
- avoid bug subtracting 1 below. */
- if (XFIXNUM (pos) == BEGV)
- return pos;
-
- len = 10;
- overlay_vec = xmalloc (len * sizeof *overlay_vec);
-
- /* Put all the overlays we want in a vector in overlay_vec.
- Store the length in len.
- prevpos gets the position of the previous change. */
- overlays_at (XFIXNUM (pos), 1, &overlay_vec, &len,
- 0, &prevpos, 1);
-
- xfree (overlay_vec);
- return make_fixnum (prevpos);
+ return make_fixnum (previous_overlay_change (XFIXNUM (pos)));
}
+
/* These functions are for debugging overlays. */
@@ -4428,19 +3904,16 @@ The car has all the overlays before the overlay center;
the cdr has all the overlays after the overlay center.
Recentering overlays moves overlays between these lists.
The lists you get are copies, so that changing them has no effect.
-However, the overlays you get are the real objects that the buffer uses. */)
+However, the overlays you get are the real objects that the buffer uses. */)
(void)
{
- Lisp_Object before = Qnil, after = Qnil;
+ Lisp_Object overlays = Qnil;
+ struct itree_node *node;
- for (struct Lisp_Overlay *ol = current_buffer->overlays_before;
- ol; ol = ol->next)
- before = Fcons (make_lisp_ptr (ol, Lisp_Vectorlike), before);
- for (struct Lisp_Overlay *ol = current_buffer->overlays_after;
- ol; ol = ol->next)
- after = Fcons (make_lisp_ptr (ol, Lisp_Vectorlike), after);
+ ITREE_FOREACH (node, current_buffer->overlays, BEG, Z, DESCENDING)
+ overlays = Fcons (node->data, overlays);
- return Fcons (Fnreverse (before), Fnreverse (after));
+ return Fcons (overlays, Qnil);
}
DEFUN ("overlay-recenter", Foverlay_recenter, Soverlay_recenter, 1, 1, 0,
@@ -4449,11 +3922,8 @@ That makes overlay lookup faster for positions near POS
(but perhaps slower
for positions far away from POS). */)
(Lisp_Object pos)
{
- ptrdiff_t p;
CHECK_FIXNUM_COERCE_MARKER (pos);
-
- p = clip_to_bounds (PTRDIFF_MIN, XFIXNUM (pos), PTRDIFF_MAX);
- recenter_overlay_lists (current_buffer, p);
+ /* Noop */
return Qnil;
}
@@ -4470,12 +3940,13 @@ DEFUN ("overlay-put", Foverlay_put, Soverlay_put, 3, 3,
0,
VALUE will be returned.*/)
(Lisp_Object overlay, Lisp_Object prop, Lisp_Object value)
{
- Lisp_Object tail, buffer;
+ Lisp_Object tail;
+ struct buffer *b;
bool changed;
CHECK_OVERLAY (overlay);
- buffer = Fmarker_buffer (OVERLAY_START (overlay));
+ b = OVERLAY_BUFFER (overlay);
for (tail = XOVERLAY (overlay)->plist;
CONSP (tail) && CONSP (XCDR (tail));
@@ -4491,15 +3962,14 @@ VALUE will be returned.*/)
set_overlay_plist
(overlay, Fcons (prop, Fcons (value, XOVERLAY (overlay)->plist)));
found:
- if (! NILP (buffer))
+ if (b)
{
if (changed)
- modify_overlay (XBUFFER (buffer),
- marker_position (OVERLAY_START (overlay)),
- marker_position (OVERLAY_END (overlay)));
+ modify_overlay (b, OVERLAY_START (overlay),
+ OVERLAY_END (overlay));
if (EQ (prop, Qevaporate) && ! NILP (value)
- && (OVERLAY_POSITION (OVERLAY_START (overlay))
- == OVERLAY_POSITION (OVERLAY_END (overlay))))
+ && (OVERLAY_START (overlay)
+ == OVERLAY_END (overlay)))
Fdelete_overlay (overlay);
}
@@ -4570,70 +4040,33 @@ report_overlay_modification (Lisp_Object start,
Lisp_Object end, bool after,
if (!after)
{
+ struct itree_node *node;
+ EMACS_INT begin_arg = XFIXNUM (start);
+ EMACS_INT end_arg = XFIXNUM (end);
/* We are being called before a change.
Scan the overlays to find the functions to call. */
last_overlay_modification_hooks_used = 0;
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- ptrdiff_t startpos, endpos;
- Lisp_Object ostart, oend;
-
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
-
- ostart = OVERLAY_START (overlay);
- oend = OVERLAY_END (overlay);
- endpos = OVERLAY_POSITION (oend);
- if (XFIXNAT (start) > endpos)
- break;
- startpos = OVERLAY_POSITION (ostart);
- if (insertion && (XFIXNAT (start) == startpos
- || XFIXNAT (end) == startpos))
- {
- Lisp_Object prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
- if (!NILP (prop))
- add_overlay_mod_hooklist (prop, overlay);
- }
- if (insertion && (XFIXNAT (start) == endpos
- || XFIXNAT (end) == endpos))
- {
- Lisp_Object prop = Foverlay_get (overlay, Qinsert_behind_hooks);
- if (!NILP (prop))
- add_overlay_mod_hooklist (prop, overlay);
- }
- /* Test for intersecting intervals. This does the right thing
- for both insertion and deletion. */
- if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos)
- {
- Lisp_Object prop = Foverlay_get (overlay, Qmodification_hooks);
- if (!NILP (prop))
- add_overlay_mod_hooklist (prop, overlay);
- }
- }
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
+ if (! current_buffer->overlays)
+ return;
+ ITREE_FOREACH (node, current_buffer->overlays,
+ begin_arg - (insertion ? 1 : 0),
+ end_arg + (insertion ? 1 : 0),
+ ASCENDING)
{
- ptrdiff_t startpos, endpos;
- Lisp_Object ostart, oend;
-
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
-
- ostart = OVERLAY_START (overlay);
- oend = OVERLAY_END (overlay);
- startpos = OVERLAY_POSITION (ostart);
- endpos = OVERLAY_POSITION (oend);
- if (XFIXNAT (end) < startpos)
- break;
- if (insertion && (XFIXNAT (start) == startpos
- || XFIXNAT (end) == startpos))
+ Lisp_Object overlay = node->data;
+ ptrdiff_t obegin = OVERLAY_START (overlay);
+ ptrdiff_t oend = OVERLAY_END (overlay);
+
+ if (insertion && (begin_arg == obegin
+ || end_arg == obegin))
{
Lisp_Object prop = Foverlay_get (overlay, Qinsert_in_front_hooks);
if (!NILP (prop))
add_overlay_mod_hooklist (prop, overlay);
}
- if (insertion && (XFIXNAT (start) == endpos
- || XFIXNAT (end) == endpos))
+ if (insertion && (begin_arg == oend
+ || end_arg == oend))
{
Lisp_Object prop = Foverlay_get (overlay, Qinsert_behind_hooks);
if (!NILP (prop))
@@ -4641,7 +4074,7 @@ report_overlay_modification (Lisp_Object start,
Lisp_Object end, bool after,
}
/* Test for intersecting intervals. This does the right thing
for both insertion and deletion. */
- if (XFIXNAT (end) > startpos && XFIXNAT (start) < endpos)
+ if (! insertion || (end_arg > obegin && begin_arg < oend))
{
Lisp_Object prop = Foverlay_get (overlay, Qmodification_hooks);
if (!NILP (prop))
@@ -4649,7 +4082,6 @@ report_overlay_modification (Lisp_Object start,
Lisp_Object end, bool after,
}
}
}
-
{
/* Call the functions recorded in last_overlay_modification_hooks.
First copy the vector contents, in case some of these hooks
@@ -4672,7 +4104,7 @@ report_overlay_modification (Lisp_Object start,
Lisp_Object end, bool after,
(which makes its markers' buffers be nil), or that (due to
some bug) it belongs to a different buffer. Only run this
hook if the overlay belongs to the current buffer. */
- if (XMARKER (OVERLAY_START (overlay_i))->buffer == current_buffer)
+ if (OVERLAY_BUFFER (overlay_i) == current_buffer)
call_overlay_mod_hooks (prop_i, overlay_i, after, arg1, arg2, arg3);
}
@@ -4694,40 +4126,6 @@ call_overlay_mod_hooks (Lisp_Object list, Lisp_Object
overlay, bool after,
}
}
-/* Delete any zero-sized overlays at position POS, if the `evaporate'
- property is set. */
-void
-evaporate_overlays (ptrdiff_t pos)
-{
- Lisp_Object hit_list = Qnil;
- if (pos <= current_buffer->overlay_center)
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- ptrdiff_t endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
- if (endpos < pos)
- break;
- if (endpos == pos && OVERLAY_POSITION (OVERLAY_START (overlay)) == pos
- && ! NILP (Foverlay_get (overlay, Qevaporate)))
- hit_list = Fcons (overlay, hit_list);
- }
- else
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- ptrdiff_t startpos = OVERLAY_POSITION (OVERLAY_START (overlay));
- if (startpos > pos)
- break;
- if (startpos == pos && OVERLAY_POSITION (OVERLAY_END (overlay)) == pos
- && ! NILP (Foverlay_get (overlay, Qevaporate)))
- hit_list = Fcons (overlay, hit_list);
- }
- for (; CONSP (hit_list); hit_list = XCDR (hit_list))
- Fdelete_overlay (XCAR (hit_list));
-}
-
/***********************************************************************
Allocation with mmap
***********************************************************************/
@@ -5352,9 +4750,7 @@ init_buffer_once (void)
bset_mark_active (&buffer_defaults, Qnil);
bset_file_format (&buffer_defaults, Qnil);
bset_auto_save_file_format (&buffer_defaults, Qt);
- set_buffer_overlays_before (&buffer_defaults, NULL);
- set_buffer_overlays_after (&buffer_defaults, NULL);
- buffer_defaults.overlay_center = BEG;
+ buffer_defaults.overlays = NULL;
XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8);
bset_truncate_lines (&buffer_defaults, Qnil);
@@ -5562,6 +4958,48 @@ defvar_per_buffer (struct Lisp_Buffer_Objfwd *bo_fwd,
const char *namestring,
emacs_abort ();
}
+#ifdef ITREE_DEBUG
+static Lisp_Object
+make_lispy_itree_node (const struct itree_node *node)
+{
+ return listn (12,
+ intern (":begin"),
+ make_fixnum (node->begin),
+ intern (":end"),
+ make_fixnum (node->end),
+ intern (":limit"),
+ make_fixnum (node->limit),
+ intern (":offset"),
+ make_fixnum (node->offset),
+ intern (":rear-advance"),
+ node->rear_advance ? Qt : Qnil,
+ intern (":front-advance"),
+ node->front_advance ? Qt : Qnil);
+}
+
+static Lisp_Object
+overlay_tree (const struct itree_tree *tree,
+ const struct itree_node *node)
+{
+ if (node == ITREE_NULL)
+ return Qnil;
+ return list3 (make_lispy_itree_node (node),
+ overlay_tree (tree, node->left),
+ overlay_tree (tree, node->right));
+}
+
+DEFUN ("overlay-tree", Foverlay_tree, Soverlay_tree, 0, 1, 0,
+ doc: /* Get the overlay tree for BUFFER. */)
+ (Lisp_Object buffer)
+{
+ struct buffer *b = decode_buffer (buffer);
+ if (! b->overlays)
+ return Qnil;
+ return overlay_tree (b->overlays, b->overlays->root);
+}
+#endif
+
+
/* Initialize the buffer routines. */
void
@@ -6533,6 +5971,10 @@ There is no reason to change that value except for
debugging purposes. */);
DEFSYM (Qautosaved, "autosaved");
+#ifdef ITREE_DEBUG
+ defsubr (&Soverlay_tree);
+#endif
+
DEFSYM (Qkill_buffer__possibly_save, "kill-buffer--possibly-save");
DEFSYM (Qbuffer_stale_function, "buffer-stale-function");
diff --git a/src/buffer.h b/src/buffer.h
index 04792374cd..dded0cd98c 100644
--- a/src/buffer.h
+++ b/src/buffer.h
@@ -1,7 +1,6 @@
/* Header file for the buffer manipulation primitives.
-Copyright (C) 1985-1986, 1993-1995, 1997-2022 Free Software Foundation,
-Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -26,6 +25,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "character.h"
#include "lisp.h"
+#include "itree.h"
INLINE_HEADER_BEGIN
@@ -701,16 +701,8 @@ struct buffer
display optimizations must be used. */
bool_bf long_line_optimizations_p : 1;
- /* List of overlays that end at or before the current center,
- in order of end-position. */
- struct Lisp_Overlay *overlays_before;
-
- /* List of overlays that end after the current center,
- in order of start-position. */
- struct Lisp_Overlay *overlays_after;
-
- /* Position where the overlay lists are centered. */
- ptrdiff_t overlay_center;
+ /* The inveral tree containing this buffer's overlays. */
+ struct itree_tree *overlays;
/* Changes in the buffer are recorded here for undo, and t means
don't record anything. This information belongs to the base
@@ -720,6 +712,14 @@ struct buffer
Lisp_Object undo_list_;
};
+struct sortvec
+{
+ Lisp_Object overlay;
+ ptrdiff_t beg, end;
+ EMACS_INT priority;
+ EMACS_INT spriority; /* Secondary priority. */
+};
+
INLINE bool
BUFFERP (Lisp_Object a)
{
@@ -1174,9 +1174,11 @@ extern EMACS_INT fix_position (Lisp_Object);
extern void delete_all_overlays (struct buffer *);
extern void reset_buffer (struct buffer *);
extern void compact_buffer (struct buffer *);
-extern void evaporate_overlays (ptrdiff_t);
-extern ptrdiff_t overlays_at (EMACS_INT, bool, Lisp_Object **,
- ptrdiff_t *, ptrdiff_t *, ptrdiff_t *, bool);
+extern ptrdiff_t overlays_at (ptrdiff_t, bool, Lisp_Object **, ptrdiff_t *,
ptrdiff_t *);
+extern ptrdiff_t overlays_in (ptrdiff_t, ptrdiff_t, bool, Lisp_Object **,
+ ptrdiff_t *, bool, bool, ptrdiff_t *);
+extern ptrdiff_t previous_overlay_change (ptrdiff_t);
+extern ptrdiff_t next_overlay_change (ptrdiff_t);
extern ptrdiff_t sort_overlays (Lisp_Object *, ptrdiff_t, struct window *);
extern void recenter_overlay_lists (struct buffer *, ptrdiff_t);
extern ptrdiff_t overlay_strings (ptrdiff_t, struct window *, unsigned char
**);
@@ -1190,6 +1192,7 @@ extern void fix_overlays_before (struct buffer *,
ptrdiff_t, ptrdiff_t);
extern void mmap_set_vars (bool);
extern void restore_buffer (Lisp_Object);
extern void set_buffer_if_live (Lisp_Object);
+extern Lisp_Object build_overlay (bool, bool, Lisp_Object);
/* Return B as a struct buffer pointer, defaulting to the current buffer. */
@@ -1230,18 +1233,16 @@ record_unwind_current_buffer (void)
This macro might evaluate its args multiple times,
and it treat some args as lvalues. */
-#define GET_OVERLAYS_AT(posn, overlays, noverlays, nextp, chrq)
\
+#define GET_OVERLAYS_AT(posn, overlays, noverlays, next) \
do { \
ptrdiff_t maxlen = 40; \
SAFE_NALLOCA (overlays, 1, maxlen);
\
- (noverlays) = overlays_at (posn, false, &(overlays), &maxlen, \
- nextp, NULL, chrq); \
+ (noverlays) = overlays_at (posn, false, &(overlays), &maxlen, next); \
if ((noverlays) > maxlen) \
{
\
maxlen = noverlays; \
SAFE_NALLOCA (overlays, 1, maxlen); \
- (noverlays) = overlays_at (posn, false, &(overlays), &maxlen, \
- nextp, NULL, chrq); \
+ (noverlays) = overlays_at (posn, false, &(overlays), &maxlen, next); \
}
\
} while (false)
@@ -1276,7 +1277,8 @@ set_buffer_intervals (struct buffer *b, INTERVAL i)
INLINE bool
buffer_has_overlays (void)
{
- return current_buffer->overlays_before || current_buffer->overlays_after;
+ return current_buffer->overlays
+ && (current_buffer->overlays->root != NULL);
}
/* Functions for accessing a character or byte,
@@ -1394,25 +1396,69 @@ buffer_window_count (struct buffer *b)
/* Overlays */
-/* Return the marker that stands for where OV starts in the buffer. */
+INLINE ptrdiff_t
+overlay_start (struct Lisp_Overlay *ov)
+{
+ if (! ov->buffer)
+ return -1;
+ return itree_node_begin (ov->buffer->overlays, ov->interval);
+}
+
+INLINE ptrdiff_t
+overlay_end (struct Lisp_Overlay *ov)
+{
+ if (! ov->buffer)
+ return -1;
+ return itree_node_end (ov->buffer->overlays, ov->interval);
+}
-#define OVERLAY_START(OV) XOVERLAY (OV)->start
+/* Return the start of OV in its buffer, or -1 if OV is not associated
+ with any buffer. */
-/* Return the marker that stands for where OV ends in the buffer. */
+INLINE ptrdiff_t
+OVERLAY_START (Lisp_Object ov)
+{
+ return overlay_start (XOVERLAY (ov));
+}
-#define OVERLAY_END(OV) XOVERLAY (OV)->end
+/* Return the end of OV in its buffer, or -1. */
+
+INLINE ptrdiff_t
+OVERLAY_END (Lisp_Object ov)
+{
+ return overlay_end (XOVERLAY (ov));
+}
/* Return the plist of overlay OV. */
-#define OVERLAY_PLIST(OV) XOVERLAY (OV)->plist
+INLINE Lisp_Object
+OVERLAY_PLIST (Lisp_Object ov)
+{
+ return XOVERLAY (ov)->plist;
+}
-/* Return the actual buffer position for the marker P.
- We assume you know which buffer it's pointing into. */
+/* Return the buffer of overlay OV. */
-INLINE ptrdiff_t
-OVERLAY_POSITION (Lisp_Object p)
+INLINE struct buffer *
+OVERLAY_BUFFER (Lisp_Object ov)
{
- return marker_position (p);
+ return XOVERLAY (ov)->buffer;
+}
+
+/* Return true, if OV's rear-advance is set. */
+
+INLINE bool
+OVERLAY_REAR_ADVANCE_P (Lisp_Object ov)
+{
+ return XOVERLAY (ov)->interval->rear_advance;
+}
+
+/* Return true, if OV's front-advance is set. */
+
+INLINE bool
+OVERLAY_FRONT_ADVANCE_P (Lisp_Object ov)
+{
+ return XOVERLAY (ov)->interval->front_advance;
}
@@ -1696,4 +1742,7 @@ dec_both (ptrdiff_t *charpos, ptrdiff_t *bytepos)
INLINE_HEADER_END
+int compare_overlays (const void *v1, const void *v2);
+void make_sortvec_item (struct sortvec *item, Lisp_Object overlay);
+
#endif /* EMACS_BUFFER_H */
diff --git a/src/callproc.c b/src/callproc.c
index 2d457b3c84..f9f840e544 100644
--- a/src/callproc.c
+++ b/src/callproc.c
@@ -39,7 +39,10 @@ extern char **environ;
&& (defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR \
|| defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR_NP) \
&& defined HAVE_DECL_POSIX_SPAWN_SETSID \
- && HAVE_DECL_POSIX_SPAWN_SETSID == 1
+ && HAVE_DECL_POSIX_SPAWN_SETSID == 1 \
+ /* posix_spawnattr_setflags rejects POSIX_SPAWN_SETSID on \
+ Haiku */ \
+ && !defined HAIKU
# include <spawn.h>
# define USABLE_POSIX_SPAWN 1
#else
@@ -645,6 +648,7 @@ call_process (ptrdiff_t nargs, Lisp_Object *args, int
filefd,
#ifndef MSDOS
+ child_signal_init ();
block_input ();
block_child_signal (&oldset);
@@ -1306,29 +1310,29 @@ emacs_posix_spawn_init_actions
(posix_spawn_file_actions_t *actions,
return error;
error = posix_spawn_file_actions_adddup2 (actions, std_in,
- STDIN_FILENO);
+ STDIN_FILENO);
if (error != 0)
goto out;
error = posix_spawn_file_actions_adddup2 (actions, std_out,
- STDOUT_FILENO);
+ STDOUT_FILENO);
if (error != 0)
goto out;
error = posix_spawn_file_actions_adddup2 (actions,
- std_err < 0 ? std_out
- : std_err,
- STDERR_FILENO);
+ std_err < 0 ? std_out
+ : std_err,
+ STDERR_FILENO);
if (error != 0)
goto out;
- error =
-#ifdef HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR
- posix_spawn_file_actions_addchdir
+ /* Haiku appears to have linkable posix_spawn_file_actions_chdir,
+ but it always fails. So use the _np function instead. */
+#if defined HAVE_POSIX_SPAWN_FILE_ACTIONS_ADDCHDIR && !defined HAIKU
+ error = posix_spawn_file_actions_addchdir (actions, cwd);
#else
- posix_spawn_file_actions_addchdir_np
+ error = posix_spawn_file_actions_addchdir_np (actions, cwd);
#endif
- (actions, cwd);
if (error != 0)
goto out;
@@ -1347,9 +1351,9 @@ emacs_posix_spawn_init_attributes (posix_spawnattr_t
*attributes,
return error;
error = posix_spawnattr_setflags (attributes,
- POSIX_SPAWN_SETSID
- | POSIX_SPAWN_SETSIGDEF
- | POSIX_SPAWN_SETSIGMASK);
+ POSIX_SPAWN_SETSID
+ | POSIX_SPAWN_SETSIGDEF
+ | POSIX_SPAWN_SETSIGMASK);
if (error != 0)
goto out;
diff --git a/src/comp.c b/src/comp.c
index b7541c5d9f..b6072a866e 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -947,7 +947,7 @@ obj_to_reloc (Lisp_Object obj)
}
xsignal1 (Qnative_ice,
- build_string ("cant't find data in relocation containers"));
+ build_string ("can't find data in relocation containers"));
assume (false);
found:
@@ -5609,7 +5609,7 @@ file_in_eln_sys_dir (Lisp_Object filename)
/* Load related routines. */
DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0,
doc: /* Load native elisp code FILENAME.
-LATE_LOAD has to be non-nil when loading for deferred compilation. */)
+LATE-LOAD has to be non-nil when loading for deferred compilation. */)
(Lisp_Object filename, Lisp_Object late_load)
{
CHECK_STRING (filename);
@@ -5868,8 +5868,21 @@ The last directory of this list is assumed to be the
system one. */);
Vnative_comp_eln_load_path = Fcons (build_string ("../native-lisp/"), Qnil);
DEFVAR_BOOL ("comp-enable-subr-trampolines", comp_enable_subr_trampolines,
- doc: /* If non-nil enable primitive trampoline synthesis.
-This makes primitive functions redefinable or advisable effectively. */);
+ doc: /* If non-nil, enable primitive trampoline synthesis.
+This makes Emacs respect redefinition or advises of primitive functions
+when they are called from Lisp code natively-compiled at `native-comp-speed'
+of 2.
+
+By default, this is enabled, and when Emacs sees a redefined or advised
+primitive called from natively-compiled Lisp, it generates a trampoline
+for it on-the-fly.
+
+Disabling this, when a trampoline for a redefined or advised primitive is
+not available from previous compilations, means that such redefinition
+or advise will not have effect on calls from natively-compiled Lisp code.
+That is, calls to primitives without existing trampolines from
+natively-compiled Lisp will behave as if the primitive was called
+directly from C. */);
DEFVAR_LISP ("comp-installed-trampolines-h", Vcomp_installed_trampolines_h,
doc: /* Hash table subr-name -> installed trampoline.
diff --git a/src/dbusbind.c b/src/dbusbind.c
index 1c74180f15..440142757e 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -422,7 +422,7 @@ xd_signature (char *signature, int dtype, int parent_type,
Lisp_Object object)
case DBUS_TYPE_STRING:
case DBUS_TYPE_OBJECT_PATH:
case DBUS_TYPE_SIGNATURE:
- /* We dont check the syntax of signature. This will be done by
+ /* We don't check the syntax of signature. This will be done by
libdbus. */
if (dtype == DBUS_TYPE_OBJECT_PATH)
XD_DBUS_VALIDATE_PATH (object)
@@ -748,7 +748,7 @@ xd_append_arg (int dtype, Lisp_Object object,
DBusMessageIter *iter)
case DBUS_TYPE_STRING:
case DBUS_TYPE_OBJECT_PATH:
case DBUS_TYPE_SIGNATURE:
- /* We dont check the syntax of signature. This will be done
+ /* We don't check the syntax of signature. This will be done
by libdbus. */
if (dtype == DBUS_TYPE_OBJECT_PATH)
XD_DBUS_VALIDATE_PATH (object)
diff --git a/src/dired.c b/src/dired.c
index c2c099f0a5..ef729df5d2 100644
--- a/src/dired.c
+++ b/src/dired.c
@@ -923,11 +923,12 @@ Elements of the attribute list are:
8. File modes, as a string of ten letters or dashes as in ls -l.
9. An unspecified value, present only for backward compatibility.
10. inode number, as a nonnegative integer.
-11. Filesystem device number, as an integer.
+11. Filesystem device identifier, as an integer or a cons cell of integers.
Large integers are bignums, so `eq' might not work on them.
On most filesystems, the combination of the inode and the device
-number uniquely identifies the file.
+identifier uniquely identifies the file. This unique file identification
+is provided by the access function `file-attribute-file-identifier'.
On MS-Windows, performance depends on `w32-get-true-file-attributes',
which see.
diff --git a/src/dispextern.h b/src/dispextern.h
index 2f5f4335fe..2afbdeabaa 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -3495,7 +3495,8 @@ extern bool cursor_in_mouse_face_p (struct window *w);
extern void tty_draw_row_with_mouse_face (struct window *, struct glyph_row *,
int, int, enum draw_glyphs_face);
extern void display_tty_menu_item (const char *, int, int, int, int, bool);
-
+extern struct glyph *x_y_to_hpos_vpos (struct window *, int, int, int *, int *,
+ int *, int *, int *);
/* Flags passed to try_window. */
#define TRY_WINDOW_CHECK_MARGINS (1 << 0)
#define TRY_WINDOW_IGNORE_FONTS_CHANGE (1 << 1)
diff --git a/src/dispnew.c b/src/dispnew.c
index 2568ba1086..5a9ba8909e 100644
--- a/src/dispnew.c
+++ b/src/dispnew.c
@@ -3152,10 +3152,19 @@ redraw_frame (struct frame *f)
update_begin (f);
if (FRAME_MSDOS_P (f))
FRAME_TERMINAL (f)->set_terminal_modes_hook (FRAME_TERMINAL (f));
+
+ if (FRAME_WINDOW_P (f))
+ /* Garbage the frame now. Otherwise, platforms that support
+ double buffering will display the blank contents of the frame
+ even though the frame should be redrawn at some point in the
+ future. */
+ SET_FRAME_GARBAGED (f);
+
clear_frame (f);
clear_current_matrices (f);
update_end (f);
fset_redisplay (f);
+
/* Mark all windows as inaccurate, so that every window will have
its redisplay done. */
mark_window_display_accurate (FRAME_ROOT_WINDOW (f), 0);
diff --git a/src/editfns.c b/src/editfns.c
index c1414071c7..17dca4708e 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -1,6 +1,6 @@
/* Lisp functions pertaining to editing. -*- coding: utf-8 -*-
-Copyright (C) 1985-1987, 1989, 1993-2022 Free Software Foundation, Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -265,51 +265,20 @@ If you set the marker not to point anywhere, the buffer
will have no mark. */)
/* Find all the overlays in the current buffer that touch position POS.
Return the number found, and store them in a vector in VEC
- of length LEN. */
+ of length LEN.
+
+ Note: this can return overlays that do not touch POS. The caller
+ should filter these out. */
static ptrdiff_t
-overlays_around (EMACS_INT pos, Lisp_Object *vec, ptrdiff_t len)
+overlays_around (ptrdiff_t pos, Lisp_Object *vec, ptrdiff_t len)
{
- ptrdiff_t idx = 0;
-
- for (struct Lisp_Overlay *tail = current_buffer->overlays_before;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object end = OVERLAY_END (overlay);
- ptrdiff_t endpos = OVERLAY_POSITION (end);
- if (endpos < pos)
- break;
- Lisp_Object start = OVERLAY_START (overlay);
- ptrdiff_t startpos = OVERLAY_POSITION (start);
- if (startpos <= pos)
- {
- if (idx < len)
- vec[idx] = overlay;
- /* Keep counting overlays even if we can't return them all. */
- idx++;
- }
- }
-
- for (struct Lisp_Overlay *tail = current_buffer->overlays_after;
- tail; tail = tail->next)
- {
- Lisp_Object overlay = make_lisp_ptr (tail, Lisp_Vectorlike);
- Lisp_Object start = OVERLAY_START (overlay);
- ptrdiff_t startpos = OVERLAY_POSITION (start);
- if (pos < startpos)
- break;
- Lisp_Object end = OVERLAY_END (overlay);
- ptrdiff_t endpos = OVERLAY_POSITION (end);
- if (pos <= endpos)
- {
- if (idx < len)
- vec[idx] = overlay;
- idx++;
- }
- }
-
- return idx;
+ /* Find all potentially rear-advance overlays at (POS - 1). Find
+ all overlays at POS, so end at (POS + 1). Find even empty
+ overlays, which due to the way 'overlays-in' works implies that
+ we might also fetch empty overlays starting at (POS + 1). */
+ return overlays_in (pos - 1, pos + 1, false, &vec, &len,
+ true, false, NULL);
}
DEFUN ("get-pos-property", Fget_pos_property, Sget_pos_property, 2, 3, 0,
@@ -369,11 +338,12 @@ at POSITION. */)
if (!NILP (tem))
{
/* Check the overlay is indeed active at point. */
- Lisp_Object start = OVERLAY_START (ol), finish = OVERLAY_END (ol);
- if ((OVERLAY_POSITION (start) == posn
- && XMARKER (start)->insertion_type == 1)
- || (OVERLAY_POSITION (finish) == posn
- && XMARKER (finish)->insertion_type == 0))
+ if ((OVERLAY_START (ol) == posn
+ && OVERLAY_FRONT_ADVANCE_P (ol))
+ || (OVERLAY_END (ol) == posn
+ && ! OVERLAY_REAR_ADVANCE_P (ol))
+ || OVERLAY_START (ol) > posn
+ || OVERLAY_END (ol) < posn)
; /* The overlay will not cover a char inserted at point. */
else
{
@@ -3551,10 +3521,15 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
|| float_conversion || conversion == 'i'
|| conversion == 'o' || conversion == 'x'
|| conversion == 'X'))
- error ("Invalid format operation %%%c",
- multibyte_format
- ? STRING_CHAR ((unsigned char *) format - 1)
- : *((unsigned char *) format - 1));
+ {
+ unsigned char *p = (unsigned char *) format - 1;
+ if (multibyte_format)
+ error ("Invalid format operation %%%c", STRING_CHAR (p));
+ else
+ error (*p <= 127 ? "Invalid format operation %%%c"
+ : "Invalid format operation char #o%03o",
+ *p);
+ }
else if (! (FIXNUMP (arg) || ((BIGNUMP (arg) || FLOATP (arg))
&& conversion != 'c')))
error ("Format specifier doesn't match argument type");
@@ -4521,7 +4496,6 @@ ring. */)
transpose_markers (start1, end1, start2, end2,
start1_byte, start1_byte + len1_byte,
start2_byte, start2_byte + len2_byte);
- fix_start_end_in_overlays (start1, end2);
}
else
{
diff --git a/src/emacs-module.c b/src/emacs-module.c
index fcdf103c19..35d6e9e0d7 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -561,7 +561,7 @@ static struct Lisp_Module_Function *
allocate_module_function (void)
{
return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function,
- interactive_form, PVEC_MODULE_FUNCTION);
+ command_modes, PVEC_MODULE_FUNCTION);
}
#define XSET_MODULE_FUNCTION(var, ptr) \
diff --git a/src/emacs.c b/src/emacs.c
index ed21cce1e2..105539aa19 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -82,6 +82,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#endif /* HAVE_WINDOW_SYSTEM */
#include "bignum.h"
+#include "itree.h"
#include "intervals.h"
#include "character.h"
#include "buffer.h"
@@ -435,9 +436,9 @@ terminate_due_to_signal (int sig, int backtrace_limit)
if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT)
{
/* Avoid abort in shut_down_emacs if we were interrupted
- by SIGINT in noninteractive usage, as in that case we
- don't care about the message stack. */
- if (sig == SIGINT && noninteractive)
+ in noninteractive usage, as in that case we don't
+ care about the message stack. */
+ if (noninteractive)
clear_message_stack ();
Fkill_emacs (make_fixnum (sig), Qnil);
}
@@ -2570,6 +2571,7 @@ static const struct standard_args standard_args[] =
{ "-init-directory", "--init-directory", 30, 1 },
{ "-no-x-resources", "--no-x-resources", 40, 0 },
{ "-no-site-file", "--no-site-file", 40, 0 },
+ { "-no-comp-spawn", "--no-comp-spawn", 60, 0 },
{ "-u", "--user", 30, 1 },
{ "-user", 0, 30, 1 },
{ "-debug-init", "--debug-init", 20, 0 },
diff --git a/src/eval.c b/src/eval.c
index 8b157824b7..99f3650fc9 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -484,8 +484,7 @@ usage: (setq [SYM VAL]...) */)
/* Like for eval_sub, we do not check declared_special here since
it's been done when let-binding. */
Lisp_Object lex_binding
- = ((!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
- && SYMBOLP (sym))
+ = (SYMBOLP (sym)
? Fassq (sym, Vinternal_interpreter_environment)
: Qnil);
if (!NILP (lex_binding))
@@ -551,8 +550,12 @@ usage: (function ARG) */)
CHECK_STRING (docstring);
cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr))));
}
- return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment,
- cdr));
+ if (NILP (Vinternal_make_interpreted_closure_function))
+ return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment,
cdr));
+ else
+ return call2 (Vinternal_make_interpreted_closure_function,
+ Fcons (Qlambda, cdr),
+ Vinternal_interpreter_environment);
}
else
/* Simply quote the argument. */
@@ -1326,7 +1329,7 @@ Then the value of the last BODY form is returned from the
`condition-case'
expression.
The special handler (:success BODY...) is invoked if BODYFORM terminated
-without signalling an error. BODY is then evaluated with VAR bound to
+without signaling an error. BODY is then evaluated with VAR bound to
the value returned by BODYFORM.
See also the function `signal' for more info.
@@ -1806,7 +1809,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object
data, bool keyboard_quit)
unbind_to (count, Qnil);
}
- /* If an error is signalled during a Lisp hook in redisplay, write a
+ /* If an error is signaled during a Lisp hook in redisplay, write a
backtrace into the buffer *Redisplay-trace*. */
if (!debugger_called && !NILP (error_symbol)
&& backtrace_on_redisplay_error
@@ -2387,9 +2390,7 @@ eval_sub (Lisp_Object form)
We do not pay attention to the declared_special flag here, since we
already did that when let-binding the variable. */
Lisp_Object lex_binding
- = (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */
- ? Fassq (form, Vinternal_interpreter_environment)
- : Qnil);
+ = Fassq (form, Vinternal_interpreter_environment);
return !NILP (lex_binding) ? XCDR (lex_binding) : Fsymbol_value (form);
}
@@ -2405,7 +2406,7 @@ eval_sub (Lisp_Object form)
if (max_lisp_eval_depth < 100)
max_lisp_eval_depth = 100;
if (lisp_eval_depth > max_lisp_eval_depth)
- xsignal0 (Qexcessive_lisp_nesting);
+ xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth));
}
Lisp_Object original_fun = XCAR (form);
@@ -2446,7 +2447,9 @@ eval_sub (Lisp_Object form)
else if (XSUBR (fun)->max_args == UNEVALLED)
val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
- else if (XSUBR (fun)->max_args == MANY)
+ else if (XSUBR (fun)->max_args == MANY
+ || XSUBR (fun)->max_args > 8)
+
{
/* Pass a vector of evaluated arguments. */
Lisp_Object *vals;
@@ -2979,7 +2982,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
if (max_lisp_eval_depth < 100)
max_lisp_eval_depth = 100;
if (lisp_eval_depth > max_lisp_eval_depth)
- xsignal0 (Qexcessive_lisp_nesting);
+ xsignal1 (Qexcessive_lisp_nesting, make_fixnum (lisp_eval_depth));
}
count = record_in_backtrace (args[0], &args[1], nargs - 1);
@@ -3009,7 +3012,8 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs,
Lisp_Object *args)
if (numargs >= subr->min_args)
{
/* Conforming call to finite-arity subr. */
- if (numargs <= subr->max_args)
+ if (numargs <= subr->max_args
+ && subr->max_args <= 8)
{
Lisp_Object argbuf[8];
Lisp_Object *a;
@@ -3045,15 +3049,13 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t
numargs, Lisp_Object *args)
return subr->function.a8 (a[0], a[1], a[2], a[3], a[4], a[5],
a[6], a[7]);
default:
- /* If a subr takes more than 8 arguments without using MANY
- or UNEVALLED, we need to extend this function to support it.
- Until this is done, there is no way to call the function. */
- emacs_abort ();
+ emacs_abort (); /* Can't happen. */
}
}
/* Call to n-adic subr. */
- if (subr->max_args == MANY)
+ if (subr->max_args == MANY
+ || subr->max_args > 8)
return subr->function.aMANY (numargs, args);
}
@@ -4370,6 +4372,11 @@ alist of active lexical bindings. */);
(Just imagine if someone makes it buffer-local). */
Funintern (Qinternal_interpreter_environment, Qnil);
+ DEFVAR_LISP ("internal-make-interpreted-closure-function",
+ Vinternal_make_interpreted_closure_function,
+ doc: /* Function to filter the env when constructing a closure.
*/);
+ Vinternal_make_interpreted_closure_function = Qnil;
+
Vrun_hooks = intern_c_string ("run-hooks");
staticpro (&Vrun_hooks);
diff --git a/src/fileio.c b/src/fileio.c
index dd7f85ec97..92335b639c 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -4167,8 +4167,7 @@ by calling `format-decode', which see. */)
bset_read_only (buf, Qnil);
bset_filename (buf, Qnil);
bset_undo_list (buf, Qt);
- eassert (buf->overlays_before == NULL);
- eassert (buf->overlays_after == NULL);
+ eassert (buf->overlays == NULL);
set_buffer_internal (buf);
Ferase_buffer ();
@@ -5000,9 +4999,10 @@ by calling `format-decode', which see. */)
unbind_to (count1, Qnil);
}
- if (!NILP (visit) && current_buffer->modtime.tv_nsec < 0)
+ if (save_errno != 0)
{
/* Signal an error if visiting a file that could not be opened. */
+ eassert (!NILP (visit) && NILP (handler));
report_file_errno ("Opening input file", orig_filename, save_errno);
}
@@ -6362,7 +6362,7 @@ init_fileio (void)
For more on why fsync does not suffice even if it works properly, see:
Roche X. Necessary step(s) to synchronize filename operations on disk.
Austin Group Defect 672, 2013-03-19
- http://austingroupbugs.net/view.php?id=672 */
+ https://austingroupbugs.net/view.php?id=672 */
write_region_inhibit_fsync = noninteractive;
}
diff --git a/src/fns.c b/src/fns.c
index 22e66d3653..035fa12935 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1,7 +1,6 @@
/* Random utility Lisp functions.
-Copyright (C) 1985-1987, 1993-1995, 1997-2022 Free Software Foundation,
-Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -433,6 +432,22 @@ If string STR1 is greater, the value is a positive number
N;
return Qt;
}
+/* Check whether the platform allows access to unaligned addresses for
+ size_t integers without trapping or undue penalty (a few cycles is OK).
+
+ This whitelist is incomplete but since it is only used to improve
+ performance, omitting cases is safe. */
+#if defined __x86_64__|| defined __amd64__ \
+ || defined __i386__ || defined __i386 \
+ || defined __arm64__ || defined __aarch64__ \
+ || defined __powerpc__ || defined __powerpc \
+ || defined __ppc__ || defined __ppc \
+ || defined __s390__ || defined __s390x__
+#define HAVE_FAST_UNALIGNED_ACCESS 1
+#else
+#define HAVE_FAST_UNALIGNED_ACCESS 0
+#endif
+
DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
doc: /* Return non-nil if STRING1 is less than STRING2 in lexicographic
order.
Case is significant.
@@ -454,23 +469,55 @@ Symbols are also allowed; their print names are used
instead. */)
&& (!STRING_MULTIBYTE (string2) || SCHARS (string2) == SBYTES (string2)))
{
/* Each argument is either unibyte or all-ASCII multibyte:
- we can compare bytewise.
- (Arbitrary multibyte strings cannot be compared bytewise because
- that would give a different order for raw bytes 80..FF.) */
+ we can compare bytewise. */
int d = memcmp (SSDATA (string1), SSDATA (string2), n);
return d < 0 || (d == 0 && n < SCHARS (string2)) ? Qt : Qnil;
}
else if (STRING_MULTIBYTE (string1) && STRING_MULTIBYTE (string2))
{
- ptrdiff_t i1 = 0, i1_byte = 0, i2 = 0, i2_byte = 0;
- while (i1 < n)
+ /* Two arbitrary multibyte strings: we cannot use memcmp because
+ the encoding for raw bytes would sort those between U+007F and U+0080
+ which isn't where we want them.
+ Instead, we skip the longest common prefix and look at
+ what follows. */
+ ptrdiff_t nb1 = SBYTES (string1);
+ ptrdiff_t nb2 = SBYTES (string2);
+ ptrdiff_t nb = min (nb1, nb2);
+ ptrdiff_t b = 0;
+
+ /* String data is normally allocated with word alignment, but
+ there are exceptions (notably pure strings) so we restrict the
+ wordwise skipping to safe architectures. */
+ if (HAVE_FAST_UNALIGNED_ACCESS)
{
- int c1 = fetch_string_char_advance_no_check (string1, &i1, &i1_byte);
- int c2 = fetch_string_char_advance_no_check (string2, &i2, &i2_byte);
- if (c1 != c2)
- return c1 < c2 ? Qt : Qnil;
+ /* First compare entire machine words. */
+ typedef size_t word_t;
+ int ws = sizeof (word_t);
+ const word_t *w1 = (const word_t *) SDATA (string1);
+ const word_t *w2 = (const word_t *) SDATA (string2);
+ while (b < nb - ws + 1 && w1[b / ws] == w2[b / ws])
+ b += ws;
}
- return i1 < SCHARS (string2) ? Qt : Qnil;
+
+ /* Scan forward to the differing byte. */
+ while (b < nb && SREF (string1, b) == SREF (string2, b))
+ b++;
+
+ if (b >= nb)
+ /* One string is a prefix of the other. */
+ return b < nb2 ? Qt : Qnil;
+
+ /* Now back up to the start of the differing characters:
+ it's the last byte not having the bit pattern 10xxxxxx. */
+ while ((SREF (string1, b) & 0xc0) == 0x80)
+ b--;
+
+ /* Compare the differing characters. */
+ ptrdiff_t i1 = 0, i2 = 0;
+ ptrdiff_t i1_byte = b, i2_byte = b;
+ int c1 = fetch_string_char_advance_no_check (string1, &i1, &i1_byte);
+ int c2 = fetch_string_char_advance_no_check (string2, &i2, &i2_byte);
+ return c1 < c2 ? Qt : Qnil;
}
else if (STRING_MULTIBYTE (string1))
{
@@ -2425,15 +2472,15 @@ with PROP is done using PREDICATE, which defaults to
`eq'.
This function doesn't signal an error if PLIST is invalid. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
{
- Lisp_Object tail = plist;
if (NILP (predicate))
return plist_get (plist, prop);
+ Lisp_Object tail = plist;
FOR_EACH_TAIL_SAFE (tail)
{
if (! CONSP (XCDR (tail)))
break;
- if (!NILP (call2 (predicate, prop, XCAR (tail))))
+ if (!NILP (call2 (predicate, XCAR (tail), prop)))
return XCAR (XCDR (tail));
tail = XCDR (tail);
}
@@ -2441,7 +2488,7 @@ This function doesn't signal an error if PLIST is
invalid. */)
return Qnil;
}
-/* Faster version of the above that works with EQ only */
+/* Faster version of Fplist_get that works with EQ only. */
Lisp_Object
plist_get (Lisp_Object plist, Lisp_Object prop)
{
@@ -2450,7 +2497,7 @@ plist_get (Lisp_Object plist, Lisp_Object prop)
{
if (! CONSP (XCDR (tail)))
break;
- if (EQ (prop, XCAR (tail)))
+ if (EQ (XCAR (tail), prop))
return XCAR (XCDR (tail));
tail = XCDR (tail);
}
@@ -2484,15 +2531,15 @@ use `(setq x (plist-put x prop val))' to be sure to use
the new value.
The PLIST is modified by side effects. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val, Lisp_Object predicate)
{
- Lisp_Object prev = Qnil, tail = plist;
if (NILP (predicate))
return plist_put (plist, prop, val);
+ Lisp_Object prev = Qnil, tail = plist;
FOR_EACH_TAIL (tail)
{
if (! CONSP (XCDR (tail)))
break;
- if (!NILP (call2 (predicate, prop, XCAR (tail))))
+ if (!NILP (call2 (predicate, XCAR (tail), prop)))
{
Fsetcar (XCDR (tail), val);
return plist;
@@ -2510,6 +2557,7 @@ The PLIST is modified by side effects. */)
return plist;
}
+/* Faster version of Fplist_put that works with EQ only. */
Lisp_Object
plist_put (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
@@ -2519,7 +2567,7 @@ plist_put (Lisp_Object plist, Lisp_Object prop,
Lisp_Object val)
if (! CONSP (XCDR (tail)))
break;
- if (EQ (prop, XCAR (tail)))
+ if (EQ (XCAR (tail), prop))
{
Fsetcar (XCDR (tail), val);
return plist;
@@ -2547,6 +2595,51 @@ It can be retrieved with `(get SYMBOL PROPNAME)'. */)
(symbol, plist_put (XSYMBOL (symbol)->u.s.plist, propname, value));
return value;
}
+
+DEFUN ("plist-member", Fplist_member, Splist_member, 2, 3, 0,
+ doc: /* Return non-nil if PLIST has the property PROP.
+PLIST is a property list, which is a list of the form
+\(PROP1 VALUE1 PROP2 VALUE2 ...).
+
+The comparison with PROP is done using PREDICATE, which defaults to
+`eq'.
+
+Unlike `plist-get', this allows you to distinguish between a missing
+property and a property with the value nil.
+The value is actually the tail of PLIST whose car is PROP. */)
+ (Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
+{
+ if (NILP (predicate))
+ return plist_member (plist, prop);
+ Lisp_Object tail = plist;
+ FOR_EACH_TAIL (tail)
+ {
+ if (!NILP (call2 (predicate, XCAR (tail), prop)))
+ return tail;
+ tail = XCDR (tail);
+ if (! CONSP (tail))
+ break;
+ }
+ CHECK_TYPE (NILP (tail), Qplistp, plist);
+ return Qnil;
+}
+
+/* Faster version of Fplist_member that works with EQ only. */
+Lisp_Object
+plist_member (Lisp_Object plist, Lisp_Object prop)
+{
+ Lisp_Object tail = plist;
+ FOR_EACH_TAIL (tail)
+ {
+ if (EQ (XCAR (tail), prop))
+ return tail;
+ tail = XCDR (tail);
+ if (! CONSP (tail))
+ break;
+ }
+ CHECK_TYPE (NILP (tail), Qplistp, plist);
+ return Qnil;
+}
DEFUN ("eql", Feql, Seql, 2, 2, 0,
doc: /* Return t if the two args are `eq' or are indistinguishable
numbers.
@@ -2703,10 +2796,9 @@ internal_equal (Lisp_Object o1, Lisp_Object o2, enum
equal_kind equal_kind,
return mpz_cmp (*xbignum_val (o1), *xbignum_val (o2)) == 0;
if (OVERLAYP (o1))
{
- if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o2),
- equal_kind, depth + 1, ht)
- || !internal_equal (OVERLAY_END (o1), OVERLAY_END (o2),
- equal_kind, depth + 1, ht))
+ if (OVERLAY_BUFFER (o1) != OVERLAY_BUFFER (o2)
+ || OVERLAY_START (o1) != OVERLAY_START (o2)
+ || OVERLAY_END (o1) != OVERLAY_END (o2))
return false;
o1 = XOVERLAY (o1)->plist;
o2 = XOVERLAY (o2)->plist;
@@ -3340,43 +3432,6 @@ FILENAME are suppressed. */)
bottleneck of Widget operation. Here is their translation to C,
for the sole reason of efficiency. */
-DEFUN ("plist-member", Fplist_member, Splist_member, 2, 3, 0,
- doc: /* Return non-nil if PLIST has the property PROP.
-PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2 ...).
-
-The comparison with PROP is done using PREDICATE, which defaults to
-`eq'.
-
-Unlike `plist-get', this allows you to distinguish between a missing
-property and a property with the value nil.
-The value is actually the tail of PLIST whose car is PROP. */)
- (Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
-{
- Lisp_Object tail = plist;
- if (NILP (predicate))
- predicate = Qeq;
- FOR_EACH_TAIL (tail)
- {
- if (!NILP (call2 (predicate, XCAR (tail), prop)))
- return tail;
- tail = XCDR (tail);
- if (! CONSP (tail))
- break;
- }
- CHECK_TYPE (NILP (tail), Qplistp, plist);
- return Qnil;
-}
-
-/* plist_member isn't used much in the Emacs sources, so just provide
- a shim so that the function name follows the same pattern as
- plist_get/plist_put. */
-Lisp_Object
-plist_member (Lisp_Object plist, Lisp_Object prop)
-{
- return Fplist_member (plist, prop, Qnil);
-}
-
DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
doc: /* In WIDGET, set PROPERTY to VALUE.
The value can later be retrieved with `widget-get'. */)
@@ -3604,7 +3659,7 @@ static signed char const
base64_char_to_value[2][UCHAR_MAX] =
static ptrdiff_t base64_encode_1 (const char *, char *, ptrdiff_t, bool, bool,
bool, bool);
static ptrdiff_t base64_decode_1 (const char *, char *, ptrdiff_t, bool,
- bool, ptrdiff_t *);
+ bool, bool, ptrdiff_t *);
static Lisp_Object base64_encode_region_1 (Lisp_Object, Lisp_Object, bool,
bool, bool);
@@ -3867,7 +3922,7 @@ base64_encode_1 (const char *from, char *to, ptrdiff_t
length,
DEFUN ("base64-decode-region", Fbase64_decode_region, Sbase64_decode_region,
- 2, 3, "r",
+ 2, 4, "r",
doc: /* Base64-decode the region between BEG and END.
Return the length of the decoded data.
@@ -3878,8 +3933,11 @@ system.
If the region can't be decoded, signal an error and don't modify the buffer.
Optional third argument BASE64URL determines whether to use the URL variant
-of the base 64 encoding, as defined in RFC 4648. */)
- (Lisp_Object beg, Lisp_Object end, Lisp_Object base64url)
+of the base 64 encoding, as defined in RFC 4648.
+If optional fourth argument INGORE-INVALID is non-nil invalid characters
+are ignored instead of signaling an error. */)
+ (Lisp_Object beg, Lisp_Object end, Lisp_Object base64url,
+ Lisp_Object ignore_invalid)
{
ptrdiff_t ibeg, iend, length, allength;
char *decoded;
@@ -3905,7 +3963,8 @@ of the base 64 encoding, as defined in RFC 4648. */)
move_gap_both (XFIXNAT (beg), ibeg);
decoded_length = base64_decode_1 ((char *) BYTE_POS_ADDR (ibeg),
decoded, length, !NILP (base64url),
- multibyte, &inserted_chars);
+ multibyte, !NILP (ignore_invalid),
+ &inserted_chars);
if (decoded_length > allength)
emacs_abort ();
@@ -3938,11 +3997,13 @@ of the base 64 encoding, as defined in RFC 4648. */)
}
DEFUN ("base64-decode-string", Fbase64_decode_string, Sbase64_decode_string,
- 1, 2, 0,
+ 1, 3, 0,
doc: /* Base64-decode STRING and return the result as a string.
Optional argument BASE64URL determines whether to use the URL variant of
-the base 64 encoding, as defined in RFC 4648. */)
- (Lisp_Object string, Lisp_Object base64url)
+the base 64 encoding, as defined in RFC 4648.
+If optional third argument IGNORE-INVALID is non-nil invalid characters are
+ignored instead of signaling an error. */)
+ (Lisp_Object string, Lisp_Object base64url, Lisp_Object ignore_invalid)
{
char *decoded;
ptrdiff_t length, decoded_length;
@@ -3958,7 +4019,8 @@ the base 64 encoding, as defined in RFC 4648. */)
/* The decoded result should be unibyte. */
ptrdiff_t decoded_chars;
decoded_length = base64_decode_1 (SSDATA (string), decoded, length,
- !NILP (base64url), 0, &decoded_chars);
+ !NILP (base64url), false,
+ !NILP (ignore_invalid), &decoded_chars);
if (decoded_length > length)
emacs_abort ();
else if (decoded_length >= 0)
@@ -3975,12 +4037,13 @@ the base 64 encoding, as defined in RFC 4648. */)
/* Base64-decode the data at FROM of LENGTH bytes into TO. If
MULTIBYTE, the decoded result should be in multibyte
- form. Store the number of produced characters in *NCHARS_RETURN. */
+ form. If IGNORE_INVALID, ignore invalid base64 characters.
+ Store the number of produced characters in *NCHARS_RETURN. */
static ptrdiff_t
base64_decode_1 (const char *from, char *to, ptrdiff_t length,
- bool base64url,
- bool multibyte, ptrdiff_t *nchars_return)
+ bool base64url, bool multibyte, bool ignore_invalid,
+ ptrdiff_t *nchars_return)
{
char const *f = from;
char const *flim = from + length;
@@ -4006,7 +4069,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
c = *f++;
v1 = b64_char_to_value[c];
}
- while (v1 < 0);
+ while (v1 < 0 || (v1 == 0 && ignore_invalid));
if (v1 == 0)
return -1;
@@ -4021,7 +4084,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
c = *f++;
v1 = b64_char_to_value[c];
}
- while (v1 < 0);
+ while (v1 < 0 || (v1 == 0 && ignore_invalid));
if (v1 == 0)
return -1;
@@ -4040,7 +4103,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
{
if (f == flim)
{
- if (!base64url)
+ if (!base64url && !ignore_invalid)
return -1;
*nchars_return = nchars;
return e - to;
@@ -4048,7 +4111,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
c = *f++;
v1 = b64_char_to_value[c];
}
- while (v1 < 0);
+ while (v1 < 0 || (v1 == 0 && ignore_invalid));
if (c == '=')
{
@@ -4082,7 +4145,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
{
if (f == flim)
{
- if (!base64url)
+ if (!base64url && !ignore_invalid)
return -1;
*nchars_return = nchars;
return e - to;
@@ -4090,7 +4153,7 @@ base64_decode_1 (const char *from, char *to, ptrdiff_t
length,
c = *f++;
v1 = b64_char_to_value[c];
}
- while (v1 < 0);
+ while (v1 < 0 || (v1 == 0 && ignore_invalid));
if (c == '=')
continue;
@@ -5029,6 +5092,7 @@ sxhash_obj (Lisp_Object obj, int depth)
? 42
: sxhash_vector (obj, depth));
}
+ /* FIXME: Use `switch`. */
else if (pvec_type == PVEC_BIGNUM)
return sxhash_bignum (obj);
else if (pvec_type == PVEC_MARKER)
@@ -5043,8 +5107,8 @@ sxhash_obj (Lisp_Object obj, int depth)
return sxhash_bool_vector (obj);
else if (pvec_type == PVEC_OVERLAY)
{
- EMACS_UINT hash = sxhash_obj (OVERLAY_START (obj), depth);
- hash = sxhash_combine (hash, sxhash_obj (OVERLAY_END (obj), depth));
+ EMACS_UINT hash = OVERLAY_START (obj);
+ hash = sxhash_combine (hash, OVERLAY_END (obj));
hash = sxhash_combine (hash, sxhash_obj (XOVERLAY (obj)->plist,
depth));
return SXHASH_REDUCE (hash);
}
diff --git a/src/font.h b/src/font.h
index 3475189206..d36c45a53c 100644
--- a/src/font.h
+++ b/src/font.h
@@ -220,13 +220,13 @@ enum font_property_index
#define FONT_WIDTH_FOR_FACE(font) \
font_style_symbolic (font, FONT_WIDTH_INDEX, true)
-/* Return the numeric weight value corresponding ot the symbol NAME. */
+/* Return the numeric weight value corresponding to the symbol NAME. */
#define FONT_WEIGHT_NAME_NUMERIC(name) \
(font_style_to_value (FONT_WEIGHT_INDEX, (name), false) >> 8)
-/* Return the numeric slant value corresponding ot the symbol NAME. */
+/* Return the numeric slant value corresponding to the symbol NAME. */
#define FONT_SLANT_NAME_NUMERIC(name) \
(font_style_to_value (FONT_SLANT_INDEX, (name), false) >> 8)
-/* Return the numeric width value corresponding ot the symbol NAME. */
+/* Return the numeric width value corresponding to the symbol NAME. */
#define FONT_WIDTH_NAME_NUMERIC(name) \
(font_style_to_value (FONT_WIDTH_INDEX, (name), false) >> 8)
diff --git a/src/fontset.c b/src/fontset.c
index 4b91eff2ef..b82737d005 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -1663,7 +1663,17 @@ overwrites the previous settings. */)
{
update_auto_fontset_alist (font_object, fontset_obj);
AUTO_FRAME_ARG (arg, Qfont, Fcons (fontset, font_object));
- Fmodify_frame_parameters (fr, arg);
+
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (f))
+ /* This is a window-system frame. Prevent changes of
+ the `font' parameter here from messing with the
+ `font-parameter' frame property, as the frame
+ parameter is not being changed by the user. */
+ gui_set_frame_parameters_1 (f, arg, true);
+ else
+#endif
+ Fmodify_frame_parameters (fr, arg);
}
}
}
diff --git a/src/frame.c b/src/frame.c
index 91b9bec82c..b57b296be5 100644
--- a/src/frame.c
+++ b/src/frame.c
@@ -1503,17 +1503,7 @@ do_switch_frame (Lisp_Object frame, int for_deletion,
Lisp_Object norecord)
sf->select_mini_window_flag = MINI_WINDOW_P (XWINDOW (sf->selected_window));
- selected_frame = frame;
-
- move_minibuffers_onto_frame (sf, for_deletion);
-
- if (f->select_mini_window_flag
- && !NILP (Fminibufferp (XWINDOW (f->minibuffer_window)->contents, Qt)))
- f->selected_window = f->minibuffer_window;
- f->select_mini_window_flag = false;
-
- if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
- last_nonminibuf_frame = XFRAME (selected_frame);
+ move_minibuffers_onto_frame (sf, frame, for_deletion);
/* If the selected window in the target frame is its mini-window, we move
to a different window, the most recently used one, unless there is a
@@ -1528,6 +1518,20 @@ do_switch_frame (Lisp_Object frame, int for_deletion,
Lisp_Object norecord)
Fset_frame_selected_window (frame, w, Qnil);
}
+ /* After setting `selected_frame`, we're temporarily in an inconsistent
+ state where (selected-window) != (frame-selected-window). Until this
+ invariant is restored we should be very careful not to run ELisp code.
+ (bug#58343) */
+ selected_frame = frame;
+
+ if (f->select_mini_window_flag
+ && !NILP (Fminibufferp (XWINDOW (f->minibuffer_window)->contents, Qt)))
+ f->selected_window = f->minibuffer_window;
+ f->select_mini_window_flag = false;
+
+ if (! FRAME_MINIBUF_ONLY_P (XFRAME (selected_frame)))
+ last_nonminibuf_frame = XFRAME (selected_frame);
+
Fselect_window (f->selected_window, norecord);
/* We want to make sure that the next event generates a frame-switch
@@ -2110,7 +2114,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force)
else
/* Ensure any minibuffers on FRAME are moved onto the selected
frame. */
- move_minibuffers_onto_frame (f, true);
+ move_minibuffers_onto_frame (f, selected_frame, true);
/* Don't let echo_area_window to remain on a deleted frame. */
if (EQ (f->minibuffer_window, echo_area_window))
@@ -4115,10 +4119,17 @@ frame_float (struct frame *f, Lisp_Object val, enum
frame_float_type what,
If a parameter is not specially recognized, do nothing special;
otherwise call the `gui_set_...' function for that parameter.
Except for certain geometry properties, always call store_frame_param
- to store the new value in the parameter alist. */
+ to store the new value in the parameter alist.
+
+ DEFAULT_PARAMETER should be set if the alist was not specified by
+ the user, or by the face code to set the `font' parameter. In that
+ case, the `font-parameter' frame parameter should not be changed,
+ so dynamic-setting.el can restore the user's selected font
+ correctly. */
void
-gui_set_frame_parameters (struct frame *f, Lisp_Object alist)
+gui_set_frame_parameters_1 (struct frame *f, Lisp_Object alist,
+ bool default_parameter)
{
Lisp_Object tail, frame;
@@ -4245,7 +4256,7 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object
alist)
}
else
{
- register Lisp_Object param_index, old_value;
+ Lisp_Object param_index, old_value;
old_value = get_frame_param (f, prop);
@@ -4256,6 +4267,12 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object
alist)
&& XFIXNAT (param_index) < ARRAYELTS (frame_parms)
&& FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)])
(*(FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)])) (f,
val, old_value);
+
+ if (!default_parameter && EQ (prop, Qfont))
+ /* The user manually specified the `font' frame parameter.
+ Save that parameter for future use by the
+ dynamic-setting code. */
+ store_frame_param (f, Qfont_parameter, val);
}
}
@@ -4406,6 +4423,11 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object
alist)
SAFE_FREE ();
}
+void
+gui_set_frame_parameters (struct frame *f, Lisp_Object alist)
+{
+ gui_set_frame_parameters_1 (f, alist, false);
+}
/* Insert a description of internally-recorded parameters of frame F
into the parameter alist *ALISTPTR that is to be given to the user.
@@ -4582,9 +4604,6 @@ gui_set_font (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
{
Lisp_Object font_object;
int fontset = -1;
-#ifdef HAVE_X_WINDOWS
- Lisp_Object font_param = arg;
-#endif
/* Set the frame parameter back to the old value because we may
fail to use ARG as the new parameter value. */
@@ -4623,16 +4642,10 @@ gui_set_font (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
error ("Unknown fontset: %s", SDATA (XCAR (arg)));
font_object = XCDR (arg);
arg = AREF (font_object, FONT_NAME_INDEX);
-#ifdef HAVE_X_WINDOWS
- font_param = Ffont_get (font_object, QCname);
-#endif
}
else if (FONT_OBJECT_P (arg))
{
font_object = arg;
-#ifdef HAVE_X_WINDOWS
- font_param = Ffont_get (font_object, QCname);
-#endif
/* This is to store the XLFD font name in the frame parameter for
backward compatibility. We should store the font-object
itself in the future. */
@@ -4663,9 +4676,7 @@ gui_set_font (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
if (FRAME_TERMINAL (f)->set_new_font_hook)
FRAME_TERMINAL (f)->set_new_font_hook (f, font_object, fontset);
store_frame_param (f, Qfont, arg);
-#ifdef HAVE_X_WINDOWS
- store_frame_param (f, Qfont_parameter, font_param);
-#endif
+
/* Recalculate tabbar height. */
f->n_tab_bar_rows = 0;
/* Recalculate toolbar height. */
@@ -4745,7 +4756,7 @@ gui_set_font_backend (struct frame *f, Lisp_Object
new_value, Lisp_Object old_va
if (FRAME_FONT (f))
{
/* Reconsider default font after backend(s) change (Bug#23386). */
- FRAME_RIF(f)->default_font_parameter (f, Qnil);
+ FRAME_RIF (f)->default_font_parameter (f, Qnil);
face_change = true;
windows_or_buffers_changed = 18;
}
@@ -5447,12 +5458,20 @@ gui_default_parameter (struct frame *f, Lisp_Object
alist, Lisp_Object prop,
enum resource_types type)
{
Lisp_Object tem;
+ bool was_unbound;
tem = gui_frame_get_arg (f, alist, prop, xprop, xclass, type);
+
if (BASE_EQ (tem, Qunbound))
- tem = deflt;
+ {
+ tem = deflt;
+ was_unbound = true;
+ }
+ else
+ was_unbound = false;
+
AUTO_FRAME_ARG (arg, prop, tem);
- gui_set_frame_parameters (f, arg);
+ gui_set_frame_parameters_1 (f, arg, was_unbound);
return tem;
}
@@ -5942,6 +5961,67 @@ This function is for internal use only. */)
return f->was_invisible ? Qt : Qnil;
}
+
+#ifdef HAVE_WINDOW_SYSTEM
+
+DEFUN ("reconsider-frame-fonts", Freconsider_frame_fonts,
+ Sreconsider_frame_fonts, 1, 1, 0,
+ doc: /* Recreate FRAME's default font using updated font parameters.
+Signal an error if FRAME is not a window system frame. This should be
+called after a `config-changed' event is received, signaling that the
+parameters (such as pixel density) used by the system to open fonts
+have changed. */)
+ (Lisp_Object frame)
+{
+ struct frame *f;
+ Lisp_Object params, font_parameter;
+
+ f = decode_window_system_frame (frame);
+
+ /* Kludge: if a `font' parameter was already specified,
+ create an alist containing just that parameter. (bug#59371)
+
+ This sounds so simple, right? Well, read on below: */
+ params = Qnil;
+
+ /* The difference between Qfont and Qfont_parameter is that the
+ latter is not set automatically by the likes of x_new_font, and
+ implicitly as the default face is realized. It is only set when
+ the user specifically specifies a `font' frame parameter, and is
+ cleared the moment the frame's font becomes defined by a face
+ attribute, instead of through the `font' frame parameter. */
+ font_parameter = get_frame_param (f, Qfont_parameter);
+
+ if (!NILP (font_parameter))
+ params = list1 (Fcons (Qfont, font_parameter));
+
+ /* First, call this to reinitialize any font backend specific
+ stuff. */
+
+ if (FRAME_RIF (f)->default_font_parameter)
+ FRAME_RIF (f)->default_font_parameter (f, params);
+
+ /* For a mysterious reason, x_default_font_parameter sets Qfont to
+ nil in the alist! */
+
+ if (!NILP (font_parameter))
+ params = list1 (Fcons (Qfont, font_parameter));
+
+ /* Now call this to apply the existing value(s) of the `default'
+ face. */
+ call2 (Qface_set_after_frame_default, frame, params);
+
+ /* Restore the value of the `font-parameter' parameter, as
+ `face-set-after-frame-default' will have changed it through its
+ calls to `set-face-attribute'. */
+ if (!NILP (font_parameter))
+ store_frame_param (f, Qfont_parameter, font_parameter);
+
+ return Qnil;
+}
+
+#endif
+
/***********************************************************************
Multimonitor data
@@ -6197,6 +6277,7 @@ syms_of_frame (void)
DEFSYM (Qiconify_top_level, "iconify-top-level");
DEFSYM (Qmake_invisible, "make-invisible");
DEFSYM (Quse_frame_synchronization, "use-frame-synchronization");
+ DEFSYM (Qfont_parameter, "font-parameter");
{
int i;
@@ -6630,6 +6711,6 @@ iconify the top level frame instead. */);
#ifdef HAVE_WINDOW_SYSTEM
defsubr (&Sx_get_resource);
defsubr (&Sx_parse_geometry);
+ defsubr (&Sreconsider_frame_fonts);
#endif
-
}
diff --git a/src/frame.h b/src/frame.h
index 458b6257e4..d6fd62b2ac 100644
--- a/src/frame.h
+++ b/src/frame.h
@@ -1670,6 +1670,7 @@ IMAGE_OPT_FROM_ID (struct frame *f, int id)
/* The class of this X application. */
#define EMACS_CLASS "Emacs"
+extern void gui_set_frame_parameters_1 (struct frame *, Lisp_Object, bool);
extern void gui_set_frame_parameters (struct frame *, Lisp_Object);
extern void gui_set_fullscreen (struct frame *, Lisp_Object, Lisp_Object);
extern void gui_set_line_spacing (struct frame *, Lisp_Object, Lisp_Object);
diff --git a/src/ftcrfont.c b/src/ftcrfont.c
index dc765e5aee..ede8f1323c 100644
--- a/src/ftcrfont.c
+++ b/src/ftcrfont.c
@@ -737,7 +737,7 @@ struct font_driver const ftcrfont_driver =
.filter_properties = ftfont_filter_properties,
.combining_capability = ftfont_combining_capability,
#ifdef HAVE_PGTK
- .cached_font_ok = ftcrfont_cached_font_ok
+ .cached_font_ok = ftcrfont_cached_font_ok,
#endif
};
#ifdef HAVE_HARFBUZZ
@@ -755,6 +755,42 @@ syms_of_ftcrfont (void)
pdumper_do_now_and_after_load (syms_of_ftcrfont_for_pdumper);
}
+#ifdef HAVE_X_WINDOWS
+
+/* Place the default font options used by Cairo on the given display
+ in OPTIONS. */
+
+void
+ftcrfont_get_default_font_options (struct x_display_info *dpyinfo,
+ cairo_font_options_t *options)
+{
+ Pixmap drawable;
+ cairo_surface_t *surface;
+
+ /* Cairo doesn't allow fetching the default font options for a
+ display, so the only option is to create a drawable, and an Xlib
+ surface for that drawable, and to get the font options from there
+ instead. */
+
+ drawable = XCreatePixmap (dpyinfo->display, dpyinfo->root_window,
+ 1, 1, dpyinfo->n_planes);
+ surface = cairo_xlib_surface_create (dpyinfo->display, drawable,
+ dpyinfo->visual, 1, 1);
+
+ if (!surface)
+ {
+ XFreePixmap (dpyinfo->display, drawable);
+ return;
+ }
+
+ cairo_surface_get_font_options (surface, options);
+ XFreePixmap (dpyinfo->display, drawable);
+ cairo_surface_destroy (surface);
+ return;
+}
+
+#endif
+
static void
syms_of_ftcrfont_for_pdumper (void)
{
diff --git a/src/ftfont.h b/src/ftfont.h
index cfab8d3154..ee56e2d760 100644
--- a/src/ftfont.h
+++ b/src/ftfont.h
@@ -84,4 +84,11 @@ struct font_info
#endif
};
+#if defined USE_CAIRO && defined HAVE_X_WINDOWS
+
+extern void ftcrfont_get_default_font_options (struct x_display_info *,
+ cairo_font_options_t *);
+
+#endif /* USE_CAIRO && HAVE_X_WINDOWS */
+
#endif /* EMACS_FTFONT_H */
diff --git a/src/gnutls.c b/src/gnutls.c
index a0de0238c4..7f0aaf85a4 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -2790,6 +2790,10 @@ Any GnuTLS extension with ID up to 100
capabilities = Fcons (intern("gnutls"), capabilities);
+# ifdef HAVE_GNUTLS_EXT__DUMBFW
+ capabilities = Fcons (intern("ClientHello Padding"), capabilities);
+# endif
+
# ifdef HAVE_GNUTLS3
capabilities = Fcons (intern("gnutls3"), capabilities);
capabilities = Fcons (intern("digests"), capabilities);
@@ -2807,16 +2811,14 @@ Any GnuTLS extension with ID up to 100
const char* name = gnutls_ext_get_name(ext);
if (name != NULL)
{
- capabilities = Fcons (intern(name), capabilities);
+ Lisp_Object cap = intern (name);
+ if (NILP (Fmemq (cap, capabilities)))
+ capabilities = Fcons (cap, capabilities);
}
}
# endif
# endif /* HAVE_GNUTLS3 */
-# ifdef HAVE_GNUTLS_EXT__DUMBFW
- capabilities = Fcons (intern("ClientHello Padding"), capabilities);
-# endif
-
# ifdef WINDOWSNT
Vlibrary_cache = Fcons (Fcons (Qgnutls, capabilities), Vlibrary_cache);
# endif /* WINDOWSNT */
diff --git a/src/haiku_support.cc b/src/haiku_support.cc
index 0f8e26d0db..3a98285677 100644
--- a/src/haiku_support.cc
+++ b/src/haiku_support.cc
@@ -653,6 +653,24 @@ public:
Quit ();
else if (msg->what == B_CLIPBOARD_CHANGED)
haiku_write (CLIPBOARD_CHANGED_EVENT, &rq);
+ else if (msg->what == B_KEY_MAP_LOADED)
+ {
+ /* Install the new keymap. Or rather, clear key_map -- Emacs
+ will fetch it again from the main thread the next time it
+ is needed. */
+ if (key_map_lock.Lock ())
+ {
+ if (key_map)
+ free (key_map);
+
+ if (key_chars)
+ free (key_chars);
+
+ key_map = NULL;
+ key_chars = NULL;
+ key_map_lock.Unlock ();
+ }
+ }
else
BApplication::MessageReceived (msg);
}
diff --git a/src/haiku_support.h b/src/haiku_support.h
index e940e69bf1..2605a75b40 100644
--- a/src/haiku_support.h
+++ b/src/haiku_support.h
@@ -383,7 +383,7 @@ struct haiku_font_pattern
/* The number of characters in `wanted_chars'. */
int want_chars_len;
- /* List of characters. The font must fullfill at least one of
+ /* List of characters. The font must fulfill at least one of
them for the match to succeed. */
int *need_one_of;
diff --git a/src/haikufns.c b/src/haikufns.c
index 711202c5df..5717d0354f 100644
--- a/src/haikufns.c
+++ b/src/haikufns.c
@@ -175,10 +175,19 @@ haiku_change_tool_bar_height (struct frame *f, int height)
void
haiku_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
diff --git a/src/haikuselect.c b/src/haikuselect.c
index bd004f4900..e8d3b5f0f7 100644
--- a/src/haikuselect.c
+++ b/src/haikuselect.c
@@ -1260,7 +1260,7 @@ syms_of_haikuselect (void)
{
DEFVAR_BOOL ("haiku-signal-invalid-refs", haiku_signal_invalid_refs,
doc: /* If nil, silently ignore invalid file names in system messages.
-Otherwise, an error will be signalled if adding a file reference to a
+Otherwise, an error will be signaled if adding a file reference to a
system message failed. */);
haiku_signal_invalid_refs = true;
diff --git a/src/haikuterm.c b/src/haikuterm.c
index 838eb128fa..496480cbc0 100644
--- a/src/haikuterm.c
+++ b/src/haikuterm.c
@@ -232,6 +232,9 @@ haiku_frame_up_to_date (struct frame *f)
be_evict_font_cache ();
up_to_date_count = 0;
}
+
+ /* Mark the frame as complete. */
+ FRAME_COMPLETE_P (f) = true;
unblock_input ();
}
@@ -265,6 +268,8 @@ haiku_clear_frame (struct frame *f)
mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f)));
+ FRAME_COMPLETE_P (f) = false;
+
block_input ();
BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f),
FRAME_PIXEL_HEIGHT (f));
@@ -1436,6 +1441,9 @@ haiku_clip_to_row (struct window *w, struct glyph_row
*row,
static void
haiku_update_begin (struct frame *f)
{
+ /* Mark the frame as incomplete so it is not flushed upon handling
+ input. */
+ FRAME_COMPLETE_P (f) = false;
}
static void
@@ -2959,6 +2967,10 @@ haiku_flush (struct frame *f)
if (FRAME_DIRTY_P (f) && !buffer_flipping_blocked_p ())
haiku_flip_buffers (f);
+ /* The frame is complete again as its contents were just
+ flushed. */
+ FRAME_COMPLETE_P (f) = true;
+
if (FRAME_VISIBLE_P (f) && !FRAME_TOOLTIP_P (f))
BWindow_Flush (FRAME_HAIKU_WINDOW (f));
}
@@ -2995,9 +3007,11 @@ haiku_default_font_parameter (struct frame *f,
Lisp_Object parms)
font = font_open_by_spec (f, Ffont_get_system_font ());
if (NILP (font))
- font = !NILP (font_param) ? font_param
- : gui_display_get_arg (dpyinfo, parms, Qfont, "font", "Font",
- RES_TYPE_STRING);
+ font = (!NILP (font_param)
+ ? font_param
+ : gui_display_get_arg (dpyinfo, parms, Qfont,
+ "font", "Font",
+ RES_TYPE_STRING));
if (! FONTP (font) && ! STRINGP (font))
{
@@ -3017,13 +3031,6 @@ haiku_default_font_parameter (struct frame *f,
Lisp_Object parms)
if (NILP (font))
error ("No suitable font was found");
}
- else if (!NILP (font_param))
- {
- /* Remember the explicit font parameter, so we can re-apply it
- after we've applied the `default' face settings. */
- AUTO_FRAME_ARG (arg, Qfont_parameter, font_param);
- gui_set_frame_parameters (f, arg);
- }
gui_default_parameter (f, parms, Qfont, font, "font", "Font",
RES_TYPE_STRING);
@@ -3086,10 +3093,15 @@ haiku_make_fullscreen_consistent (struct frame *f)
static void
haiku_flush_dirty_back_buffer_on (struct frame *f)
{
- if (!FRAME_GARBAGED_P (f)
- && !buffer_flipping_blocked_p ()
- && FRAME_DIRTY_P (f))
- haiku_flip_buffers (f);
+ if (FRAME_GARBAGED_P (f)
+ || buffer_flipping_blocked_p ()
+ /* If the frame is not already up to date, do not flush buffers
+ on input, as that will result in flicker. */
+ || !FRAME_COMPLETE_P (f)
+ || !FRAME_DIRTY_P (f))
+ return;
+
+ haiku_flip_buffers (f);
}
/* N.B. that support for TYPE must be explicitly added to
@@ -3135,6 +3147,7 @@ haiku_read_socket (struct terminal *terminal, struct
input_event *hold_quit)
int button_or_motion_p, do_help;
enum haiku_event_type type;
struct input_event inev, inev2;
+ struct frame *mouse_frame;
message_count = 0;
button_or_motion_p = 0;
@@ -3252,9 +3265,13 @@ haiku_read_socket (struct terminal *terminal, struct
input_event *hold_quit)
|| !EQ (f->tool_bar_window, hlinfo->mouse_face_window)
|| !EQ (f->tab_bar_window, hlinfo->mouse_face_window)))
{
+ mouse_frame = hlinfo->mouse_face_mouse_frame;
+
clear_mouse_face (hlinfo);
hlinfo->mouse_face_hidden = true;
- haiku_flush_dirty_back_buffer_on (f);
+
+ if (mouse_frame)
+ haiku_flush_dirty_back_buffer_on (mouse_frame);
}
inev.code = b->keysym ? b->keysym : b->multibyte_char;
diff --git a/src/haikuterm.h b/src/haikuterm.h
index 86274fd42a..70e8cf948b 100644
--- a/src/haikuterm.h
+++ b/src/haikuterm.h
@@ -174,6 +174,10 @@ struct haiku_output
displayed yet. */
bool_bf dirty_p : 1;
+ /* Whether or not the frame is complete, i.e. safe to flush on
+ input. */
+ bool_bf complete_p : 1;
+
struct font *font;
/* The pending position we're waiting for. */
@@ -275,6 +279,7 @@ struct scroll_bar
#define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec))
#define FRAME_DIRTY_P(f) (FRAME_OUTPUT_DATA (f)->dirty_p)
+#define FRAME_COMPLETE_P(f) (FRAME_OUTPUT_DATA (f)->complete_p)
#define MAKE_FRAME_DIRTY(f) (FRAME_DIRTY_P (f) = 1)
#define FRAME_OUTPUT_DATA(f) ((f)->output_data.haiku)
#define FRAME_HAIKU_WINDOW(f) (FRAME_OUTPUT_DATA (f)->window)
diff --git a/src/image.c b/src/image.c
index 1e323ba66a..600c32571e 100644
--- a/src/image.c
+++ b/src/image.c
@@ -1843,7 +1843,9 @@ image_clear_image (struct frame *f, struct image *img)
{
block_input ();
image_clear_image_1 (f, img,
- CLEAR_IMAGE_PIXMAP | CLEAR_IMAGE_MASK | CLEAR_IMAGE_COLORS);
+ (CLEAR_IMAGE_PIXMAP
+ | CLEAR_IMAGE_MASK
+ | CLEAR_IMAGE_COLORS));
unblock_input ();
}
@@ -2980,7 +2982,8 @@ lookup_image (struct frame *f, Lisp_Object spec, int
face_id)
unblock_input ();
}
- /* We're using IMG, so set its timestamp to `now'. */
+ /* IMG is now being used, so set its timestamp to the current
+ time. */
img->timestamp = current_timespec ();
/* Value is the image id. */
@@ -3238,12 +3241,13 @@ x_create_x_image_and_pixmap (struct frame *f, int
width, int height, int depth,
static void
x_destroy_x_image (XImage *ximg)
{
- eassert (input_blocked_p ());
if (ximg)
{
xfree (ximg->data);
ximg->data = NULL;
}
+
+ XDestroyImage (ximg);
}
# if !defined USE_CAIRO && defined HAVE_XRENDER
@@ -6224,26 +6228,28 @@ static void
image_from_emacs_colors (struct frame *f, struct image *img, Emacs_Color
*colors)
{
int x, y;
- Emacs_Pix_Container oimg = NULL;
+ Emacs_Pix_Container ximage;
Emacs_Color *p;
+ ximage = NULL;
+
init_color_table ();
image_clear_image_1 (f, img, CLEAR_IMAGE_PIXMAP | CLEAR_IMAGE_COLORS);
image_create_x_image_and_pixmap (f, img, img->width, img->height, 0,
- &oimg, 0);
+ &ximage, 0);
p = colors;
for (y = 0; y < img->height; ++y)
for (x = 0; x < img->width; ++x, ++p)
{
unsigned long pixel;
pixel = lookup_rgb_color (f, p->red, p->green, p->blue);
- PUT_PIXEL (oimg, x, y, pixel);
+ PUT_PIXEL (ximage, x, y, pixel);
}
xfree (colors);
- image_put_x_image (f, img, oimg, 0);
+ image_put_x_image (f, img, ximage, false);
#ifdef COLOR_TABLE_SUPPORT
img->colors = colors_in_color_table (&img->ncolors);
free_color_table ();
@@ -12207,7 +12213,15 @@ non-numeric, there is no explicit limit on the size of
images. */);
# endif
DEFSYM (Qgobject, "gobject");
#endif /* HAVE_NTGUI */
-#endif /* HAVE_RSVG */
+#elif defined HAVE_NATIVE_IMAGE_API \
+ && ((defined HAVE_NS && defined NS_IMPL_COCOA) \
+ || defined HAVE_HAIKU)
+ DEFSYM (Qsvg, "svg");
+
+ /* On Haiku, the SVG translator may not be installed. */
+ if (image_can_use_native_api (Qsvg))
+ add_image_type (Qsvg);
+#endif
#ifdef HAVE_NS
DEFSYM (Qheic, "heic");
diff --git a/src/indent.c b/src/indent.c
index aa905f387b..4671ccccf9 100644
--- a/src/indent.c
+++ b/src/indent.c
@@ -224,9 +224,6 @@ skip_invisible (ptrdiff_t pos, ptrdiff_t *next_boundary_p,
ptrdiff_t to, Lisp_Ob
XSETFASTINT (position, pos);
XSETBUFFER (buffer, current_buffer);
- /* Give faster response for overlay lookup near POS. */
- recenter_overlay_lists (current_buffer, pos);
-
/* We must not advance farther than the next overlay change.
The overlay change might change the invisible property;
or there might be overlay strings to be displayed there. */
@@ -518,7 +515,7 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col,
ptrdiff_t *endpos)
{
ptrdiff_t start;
if (OVERLAYP (overlay))
- *endpos = OVERLAY_POSITION (OVERLAY_END (overlay));
+ *endpos = OVERLAY_END (overlay);
else
get_property_and_range (pos, Qdisplay, &val, &start, endpos, Qnil);
@@ -637,6 +634,11 @@ scan_for_column (ptrdiff_t *endpos, EMACS_INT *goalcol,
scan_byte = CHAR_TO_BYTE (scan);
if (scan >= end)
goto endloop;
+ /* We may have over-stepped cmp_it.stop_pos while skipping
+ the invisible text. If so, update cmp_it.stop_pos. */
+ if (scan > cmp_it.stop_pos && cmp_it.id < 0)
+ composition_reseat_it (&cmp_it, scan, scan_byte, end,
+ w, -1, NULL, Qnil);
}
/* Test reaching the goal column. We do this after skipping
@@ -1358,6 +1360,9 @@ compute_motion (ptrdiff_t from, ptrdiff_t frombyte,
EMACS_INT fromvpos,
pos = newpos;
pos_byte = CHAR_TO_BYTE (pos);
}
+ if (newpos > cmp_it.stop_pos && cmp_it.id < 0)
+ composition_reseat_it (&cmp_it, pos, pos_byte, to,
+ win, -1, NULL, Qnil);
rarely_quit (++quit_count);
}
diff --git a/src/insdel.c b/src/insdel.c
index b9fba4cd74..d483736c03 100644
--- a/src/insdel.c
+++ b/src/insdel.c
@@ -272,6 +272,7 @@ adjust_markers_for_delete (ptrdiff_t from, ptrdiff_t
from_byte,
m->bytepos = from_byte;
}
}
+ adjust_overlays_for_delete (from, to - from);
}
@@ -288,7 +289,6 @@ adjust_markers_for_insert (ptrdiff_t from, ptrdiff_t
from_byte,
ptrdiff_t to, ptrdiff_t to_byte, bool before_markers)
{
struct Lisp_Marker *m;
- bool adjusted = 0;
ptrdiff_t nchars = to - from;
ptrdiff_t nbytes = to_byte - from_byte;
@@ -304,8 +304,6 @@ adjust_markers_for_insert (ptrdiff_t from, ptrdiff_t
from_byte,
{
m->bytepos = to_byte;
m->charpos = to;
- if (m->insertion_type)
- adjusted = 1;
}
}
else if (m->bytepos > from_byte)
@@ -314,15 +312,7 @@ adjust_markers_for_insert (ptrdiff_t from, ptrdiff_t
from_byte,
m->charpos += nchars;
}
}
-
- /* Adjusting only markers whose insertion-type is t may result in
- - disordered start and end in overlays, and
- - disordered overlays in the slot `overlays_before' of current_buffer. */
- if (adjusted)
- {
- fix_start_end_in_overlays (from, to);
- fix_overlays_before (current_buffer, from, to);
- }
+ adjust_overlays_for_insert (from, to - from, before_markers);
}
/* Adjust point for an insertion of NBYTES bytes, which are NCHARS characters.
@@ -359,6 +349,11 @@ adjust_markers_for_replace (ptrdiff_t from, ptrdiff_t
from_byte,
ptrdiff_t diff_bytes = new_bytes - old_bytes;
adjust_suspend_auto_hscroll (from, from + old_chars);
+
+ /* FIXME: When OLD_CHARS is 0, this "replacement" is really just an
+ insertion, but the behavior we provide here in that case is that of
+ `insert-before-markers` rather than that of `insert`.
+ Maybe not a bug, but not a feature either. */
for (m = BUF_MARKERS (current_buffer); m; m = m->next)
{
if (m->bytepos >= prev_to_byte)
@@ -374,6 +369,10 @@ adjust_markers_for_replace (ptrdiff_t from, ptrdiff_t
from_byte,
}
check_markers ();
+
+ adjust_overlays_for_insert (from + old_chars, new_chars, true);
+ if (old_chars)
+ adjust_overlays_for_delete (from, old_chars);
}
/* Starting at POS (BYTEPOS), find the byte position corresponding to
@@ -933,7 +932,6 @@ insert_1_both (const char *string,
if (Z - GPT < END_UNCHANGED)
END_UNCHANGED = Z - GPT;
- adjust_overlays_for_insert (PT, nchars);
adjust_markers_for_insert (PT, PT_BYTE,
PT + nchars, PT_BYTE + nbytes,
before_markers);
@@ -1065,7 +1063,6 @@ insert_from_string_1 (Lisp_Object string, ptrdiff_t pos,
ptrdiff_t pos_byte,
if (Z - GPT < END_UNCHANGED)
END_UNCHANGED = Z - GPT;
- adjust_overlays_for_insert (PT, nchars);
adjust_markers_for_insert (PT, PT_BYTE, PT + nchars,
PT_BYTE + outgoing_nbytes,
before_markers);
@@ -1143,9 +1140,8 @@ insert_from_gap (ptrdiff_t nchars, ptrdiff_t nbytes, bool
text_at_gap_tail)
insert_from_gap_1 (nchars, nbytes, text_at_gap_tail);
- adjust_overlays_for_insert (ins_charpos, nchars);
adjust_markers_for_insert (ins_charpos, ins_bytepos,
- ins_charpos + nchars, ins_bytepos + nbytes, 0);
+ ins_charpos + nchars, ins_bytepos + nbytes, false);
if (buffer_intervals (current_buffer))
{
@@ -1291,10 +1287,9 @@ insert_from_buffer_1 (struct buffer *buf,
if (Z - GPT < END_UNCHANGED)
END_UNCHANGED = Z - GPT;
- adjust_overlays_for_insert (PT, nchars);
adjust_markers_for_insert (PT, PT_BYTE, PT + nchars,
PT_BYTE + outgoing_nbytes,
- 0);
+ false);
offset_intervals (current_buffer, PT, nchars);
@@ -1356,17 +1351,12 @@ adjust_after_replace (ptrdiff_t from, ptrdiff_t
from_byte,
len, len_byte);
else
adjust_markers_for_insert (from, from_byte,
- from + len, from_byte + len_byte, 0);
+ from + len, from_byte + len_byte, false);
if (nchars_del > 0)
record_delete (from, prev_text, false);
record_insert (from, len);
- if (len > nchars_del)
- adjust_overlays_for_insert (from, len - nchars_del);
- else if (len < nchars_del)
- adjust_overlays_for_delete (from, nchars_del - len);
-
offset_intervals (current_buffer, from, len - nchars_del);
if (from < PT)
@@ -1378,8 +1368,6 @@ adjust_after_replace (ptrdiff_t from, ptrdiff_t from_byte,
check_markers ();
- if (len == 0)
- evaporate_overlays (from);
modiff_incr (&MODIFF, nchars_del + len);
CHARS_MODIFF = MODIFF;
}
@@ -1547,14 +1535,9 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object
new,
which make the original byte positions of the markers
invalid. */
adjust_markers_bytepos (from, from_byte, from + inschars,
- from_byte + outgoing_insbytes, 1);
+ from_byte + outgoing_insbytes, true);
}
- /* Adjust the overlay center as needed. This must be done after
- adjusting the markers that bound the overlays. */
- adjust_overlays_for_delete (from, nchars_del);
- adjust_overlays_for_insert (from, inschars);
-
offset_intervals (current_buffer, from, inschars - nchars_del);
/* Get the intervals for the part of the string we are inserting--
@@ -1577,9 +1560,6 @@ replace_range (ptrdiff_t from, ptrdiff_t to, Lisp_Object
new,
(from_byte + outgoing_insbytes
- (PT_BYTE < to_byte ? PT_BYTE : to_byte)));
- if (outgoing_insbytes == 0)
- evaporate_overlays (from);
-
check_markers ();
modiff_incr (&MODIFF, nchars_del + inschars);
@@ -1691,18 +1671,10 @@ replace_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
sequences which make the original byte positions of the
markers invalid. */
adjust_markers_bytepos (from, from_byte, from + inschars,
- from_byte + insbytes, 1);
+ from_byte + insbytes, true);
}
}
- /* Adjust the overlay center as needed. This must be done after
- adjusting the markers that bound the overlays. */
- if (nchars_del != inschars)
- {
- adjust_overlays_for_insert (from, inschars);
- adjust_overlays_for_delete (from + inschars, nchars_del);
- }
-
offset_intervals (current_buffer, from, inschars - nchars_del);
/* Relocate point as if it were a marker. */
@@ -1715,9 +1687,6 @@ replace_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
adjust_point (inschars - nchars_del, insbytes - nbytes_del);
}
- if (insbytes == 0)
- evaporate_overlays (from);
-
check_markers ();
modiff_incr (&MODIFF, nchars_del + inschars);
@@ -1905,10 +1874,6 @@ del_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
offset_intervals (current_buffer, from, - nchars_del);
- /* Adjust the overlay center as needed. This must be done after
- adjusting the markers that bound the overlays. */
- adjust_overlays_for_delete (from, nchars_del);
-
GAP_SIZE += nbytes_del;
ZV_BYTE -= nbytes_del;
Z_BYTE -= nbytes_del;
@@ -1930,8 +1895,6 @@ del_range_2 (ptrdiff_t from, ptrdiff_t from_byte,
check_markers ();
- evaporate_overlays (from);
-
#ifdef HAVE_TREE_SITTER
eassert (from_byte <= to_byte);
eassert (from_byte >= 0);
diff --git a/src/intervals.c b/src/intervals.c
index 7f11981557..78f4f6b617 100644
--- a/src/intervals.c
+++ b/src/intervals.c
@@ -1836,8 +1836,8 @@ adjust_for_invis_intang (ptrdiff_t pos, ptrdiff_t
test_offs, ptrdiff_t adj,
== (test_offs == 0 ? 1 : -1))
/* Invisible property is from an overlay. */
: (test_offs == 0
- ? XMARKER (OVERLAY_START (invis_overlay))->insertion_type == 0
- : XMARKER (OVERLAY_END (invis_overlay))->insertion_type == 1)))
+ ? ! OVERLAY_FRONT_ADVANCE_P (invis_overlay)
+ : OVERLAY_REAR_ADVANCE_P (invis_overlay))))
pos += adj;
return pos;
diff --git a/src/itree.c b/src/itree.c
new file mode 100644
index 0000000000..04fa9e827a
--- /dev/null
+++ b/src/itree.c
@@ -0,0 +1,1428 @@
+/* This file implements an efficient interval data-structure.
+
+Copyright (C) 2017-2022 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 <http://www.gnu.org/licenses/>. */
+
+#include <config.h>
+#include <math.h>
+
+#include "itree.h"
+
+/*
+ Intervals of the form [BEGIN, END), are stored as nodes inside a RB
+ tree, ordered by BEGIN. The core operation of this tree (besides
+ insert, remove, etc.) is finding all intervals intersecting with
+ some given interval. In order to perform this operation
+ efficiently, every node stores a third value called LIMIT. (See
+ https://en.wikipedia.org/wiki/Interval_tree#Augmented_tree and its
+ source Introduction to Algorithms, Cormen et al. .)
+
+ ==== Finding intervals ====
+
+ If we search for all intervals intersecting with (X, Y], we look at
+ some node and test whether
+
+ NODE.BEGIN > Y
+
+ Due to the invariant of the search tree, we know, that we may
+ safely prune NODE's right subtree if this test succeeds, since all
+ intervals begin strictly after Y.
+
+ But we can not make such an assumptions about the left tree, since
+ all we know is that the intervals in this subtree must start before
+ or at NODE.BEGIN. So we can't tell, whether they end before X or
+ not. To solve this problem we add another attribute to each node,
+ called LIMIT.
+
+ The LIMIT of a node is the largest END value occurring in the nodes
+ subtree (including the node itself). Thus, we may look at the left
+ child of some NODE and test whether
+
+ NODE.left.LIMIT < X
+
+ and this tells us, if all intervals in the left subtree of NODE end
+ before X and if they can be pruned.
+
+ Conversely, if this inequality is false, the left subtree must
+ contain at least one intersecting interval, giving a resulting time
+ complexity of O(K*log(N)) for this operation, where K is the size
+ of the result set and N the size of the tree.
+
+ ==== FIXME: bug#58342 some important operations remain slow ===
+
+ The amortized costs of Emacs' previous-overlay-change and
+ next-overlay-change functions are O(N) with this data structure.
+ The root problem is that we only have an order for the BEG field,
+ but not the END. The previous/next overlay change operations need
+ to find the nearest point where there is *either* an interval BEG
+ or END point, but there is no efficient way to narrow the search
+ space over END positions.
+
+ Consider the case where next-overlay-change is called at POS, all
+ interval BEG positions are less than pos POS and all interval END
+ posistions are after. These END positions have no order, and so
+ *every* interval must be examined. This is at least O(N). The
+ previous-overlay-change case is similar. The root issue is that
+ the iterative "narrowing" approach is not guaranteed to reduce the
+ search space in logarithmic time, since END is not ordered in the
+ tree.
+
+ One might argue that the LIMIT value will do this narrowing, but
+ this narrowing is O(K*log(N)) where K is the size of the result
+ set. If we are interested in finding the node in a range with the
+ smallest END, we might have to examine all K nodes in that range.
+ In the case of the *-overlay-channge functions, K may well be equal
+ to N.
+
+ Ideally, a tree based data structure for overlays would have
+ O(log(N)) performance for previous-overlay-change and
+ next-overlay-change, as these are called in performance sensitive
+ situations such as redisplay. The only way I can think of
+ achieving this is by keeping one ordering by BEG and a separate
+ ordering by END, and then performing logic quite similar to the
+ current Emacs overlays-before and overlays-after lists.
+
+ ==== Adjusting intervals ====
+
+ Since this data-structure will be used for overlays in an Emacs
+ buffer, a second core operation is the ability to insert and delete
+ gaps in the tree. This models the insertion and deletion of text
+ in a buffer and the effects it may have on the positions of
+ overlays.
+
+ Consider this: Something gets inserted at position P into a buffer
+ and assume that all overlays occur strictly after P. Ordinarily,
+ we would have to iterate all overlays and increment their BEGIN and
+ END values accordingly (the insertion of text pushes them back).
+ In order to avoid this, we introduce yet another node attribute,
+ called OFFSET.
+
+ The OFFSET of some subtree, represented by its root, is the
+ amount of shift that needs to be applied to its BEGIN, END and
+ LIMIT values, in order to get to the actual buffer positions.
+ Coming back to the example, all we would need to do in this case,
+ is to increment the OFFSET of the tree's root, without any
+ traversal of the tree itself.
+
+ As a consequence, the real values of BEGIN, END and LIMIT of some
+ NODE need to be computed by incrementing them by the sum of NODE's
+ OFFSET and all of its ancestors offsets. Therefore, we store a
+ counter (otick) inside every node and also the tree, by which we
+ remember the fact, that a node's path to the root has no offsets
+ applied (i.e. its values are up to date). This is the case if some
+ node's value differs from the tree's one, the later of which is
+ incremented whenever some node's offset has changed. */
+
+/* +=======================================================================+
+ * | Stack
+ * +=======================================================================+ */
+
+/* Simple dynamic array. */
+struct itree_stack
+{
+ struct itree_node **nodes;
+ size_t size;
+ size_t length;
+};
+
+/* This is just a simple dynamic array with stack semantics. */
+
+static struct itree_stack*
+itree_stack_create (intmax_t initial_size)
+{
+ struct itree_stack *stack = xmalloc (sizeof (struct itree_stack));
+ stack->size = max (0, initial_size);
+ stack->nodes = xmalloc (stack->size * sizeof (struct itree_node*));
+ stack->length = 0;
+ return stack;
+}
+
+static void
+itree_stack_destroy (struct itree_stack *stack)
+{
+ if (! stack)
+ return;
+ if (stack->nodes)
+ xfree (stack->nodes);
+ xfree (stack);
+}
+
+static inline void
+itree_stack_ensure_space (struct itree_stack *stack, uintmax_t nelements)
+{
+ if (nelements > stack->size)
+ {
+ stack->size = (nelements + 1) * 2;
+ stack->nodes = xrealloc (stack->nodes,
+ stack->size * sizeof (*stack->nodes));
+ }
+}
+
+/* Push NODE on the STACK, while settings its visited flag to FLAG. */
+
+static inline void
+itree_stack_push (struct itree_stack *stack, struct itree_node *node)
+{
+ eassert (node);
+ itree_stack_ensure_space (stack, stack->length + 1);
+
+ stack->nodes[stack->length] = node;
+ stack->length++;
+}
+
+static inline struct itree_node *
+itree_stack_pop (struct itree_stack *stack)
+{
+ if (stack->length == 0)
+ return NULL;
+ return stack->nodes[--stack->length];
+}
+
+
+/* +-----------------------------------------------------------------------+ */
+
+static int
+itree_max_height (const struct itree_tree *tree)
+{
+ return 2 * log (tree->size + 1) / log (2) + 0.5;
+}
+
+struct check_subtree_result
+{
+ /* Node count of the tree. */
+ int size;
+
+ /* Limit of the tree (max END). */
+ ptrdiff_t limit;
+
+ /* Black height of the tree. */
+ int black_height;
+};
+
+static struct check_subtree_result
+check_subtree (struct itree_node *node,
+ bool check_red_black_invariants, uintmax_t tree_otick,
+ ptrdiff_t offset, ptrdiff_t min_begin,
+ ptrdiff_t max_begin)
+{
+ struct check_subtree_result result = { .size = 0,
+ .limit = PTRDIFF_MIN,
+ .black_height = 0 };
+ if (node == NULL)
+ return result;
+
+ /* Validate structure. */
+ eassert (node->left == NULL || node->left->parent == node);
+ eassert (node->right == NULL || node->right->parent == node);
+
+ /* Validate otick. A node's otick must be <= to the tree's otick
+ and <= to its parent's otick.
+
+ Note: we cannot assert that (NODE.otick == NODE.parent.otick)
+ implies (NODE.offset == 0) because itree_inherit_offset()
+ doesn't always update otick. It could, but it is not clear there
+ is a need. */
+ eassert (node->otick <= tree_otick);
+ eassert (node->parent == NULL || node->otick <= node->parent->otick);
+ eassert (node->otick != tree_otick || node->offset == 0);
+
+ offset += node->offset;
+ ptrdiff_t begin = node->begin + offset;
+ ptrdiff_t end = node->end + offset;
+ ptrdiff_t limit = node->limit + offset;
+
+ eassert (min_begin <= max_begin);
+ eassert (min_begin <= begin);
+ eassert (begin <= max_begin);
+ eassert (end <= limit);
+
+ struct check_subtree_result left_result
+ = check_subtree (node->left, check_red_black_invariants,
+ tree_otick, offset, min_begin, begin);
+ struct check_subtree_result right_result
+ = check_subtree (node->right, check_red_black_invariants,
+ tree_otick, offset, begin, max_begin);
+
+ eassert (left_result.limit <= limit);
+ eassert (right_result.limit <= limit);
+ eassert (limit == max (end, max (left_result.limit, right_result.limit)));
+
+ if (check_red_black_invariants)
+ {
+ eassert (left_result.black_height == right_result.black_height);
+ eassert (node->parent == NULL || !node->red || !node->parent->red);
+ }
+
+ result.size = 1 + left_result.size + right_result.size;
+ result.limit = limit;
+ result.black_height = (node->red ? 0 : 1) + left_result.black_height;
+ return result;
+}
+
+/* Validate invariants for TREE. If CHECK_RED_BLACK_INVARIANTS, red
+ nodes with red children are considered invalid.
+
+ This runs in constant time when ENABLE_OVERLAY_CHECKING is 0
+ (i.e. Emacs is not configured with
+ "--enable_checking=yes,overlays"). In this mode it can't check all
+ the invariants. When ENABLE_OVERLAY_CHECKING is 1 it checks the
+ entire tree and validates all invariants.
+*/
+static bool
+check_tree (struct itree_tree *tree,
+ bool check_red_black_invariants)
+{
+ eassert (tree != NULL);
+ eassert (tree->size >= 0);
+ eassert ((tree->size == 0) == (tree->root == NULL));
+ if (tree->root == NULL)
+ return true;
+ eassert (tree->root->parent == NULL);
+ eassert (!check_red_black_invariants || !tree->root->red);
+
+ struct itree_node *node = tree->root;
+ struct check_subtree_result result
+ = check_subtree (node, check_red_black_invariants, tree->otick,
+ node->offset, PTRDIFF_MIN,
+ PTRDIFF_MAX);
+ eassert (result.size == tree->size);
+
+ /* The only way this function fails is eassert(). */
+ return true;
+}
+
+/* +=======================================================================+
+ * | Internal Functions
+ * +=======================================================================+ */
+
+static bool
+null_safe_is_red (struct itree_node *node)
+{
+ return node != NULL && node->red;
+}
+
+static bool
+null_safe_is_black (struct itree_node *node)
+{
+ return node == NULL || !node->red; /* NULL nodes are black */
+}
+
+static inline ptrdiff_t
+itree_newlimit (struct itree_node *node)
+{
+ eassert (node != NULL);
+ return max (node->end,
+ max (node->left == NULL
+ ? PTRDIFF_MIN
+ : node->left->limit + node->left->offset,
+ node->right == NULL
+ ? PTRDIFF_MIN
+ : node->right->limit + node->right->offset));
+}
+
+/* Update NODE's limit attribute according to its children. */
+
+static void
+itree_update_limit (struct itree_node *node)
+{
+ if (node == NULL)
+ return;
+
+ node->limit = itree_newlimit (node);
+}
+
+/* Apply NODE's offset to its begin, end and limit values and
+ propagate it to its children.
+
+ Does nothing, if NODE is clean, i.e. NODE.otick = tree.otick .
+*/
+
+static void
+itree_inherit_offset (uintmax_t otick, struct itree_node *node)
+{
+ eassert (node->parent == NULL || node->parent->otick >= node->otick);
+ if (node->otick == otick)
+ {
+ eassert (node->offset == 0);
+ return;
+ }
+
+ /* Offsets can be inherited from dirty nodes (with out of date
+ otick) during removal, since we do not travel down from the root
+ in that case. In this case rotations are performed on
+ potentially "dirty" nodes, where we only need to make sure the
+ *local* offsets are zero. */
+
+ if (node->offset)
+ {
+ node->begin += node->offset;
+ node->end += node->offset;
+ node->limit += node->offset;
+ if (node->left != NULL)
+ node->left->offset += node->offset;
+ if (node->right != NULL)
+ node->right->offset += node->offset;
+ node->offset = 0;
+ }
+ /* The only thing that matters about `otick` is whether it's equal to
+ that of the tree. We could also "blindly" inherit from parent->otick,
+ but we need to tree's `otick` anyway for when there's no parent. */
+ if (node->parent == NULL || node->parent->otick == otick)
+ node->otick = otick;
+}
+
+/* Update limit of NODE and its ancestors. Stop when it becomes
+ stable, i.e. new_limit = old_limit. */
+
+static void
+itree_propagate_limit (struct itree_node *node)
+{
+ ptrdiff_t newlimit;
+
+ if (node == NULL)
+ return;
+
+ while (1)
+ {
+ newlimit = itree_newlimit (node);
+
+ if (newlimit == node->limit)
+ break;
+ node->limit = newlimit;
+ if (node->parent == NULL)
+ break;
+ node = node->parent;
+ }
+}
+
+static struct itree_node*
+itree_validate (struct itree_tree *tree, struct itree_node *node)
+{
+
+ if (tree->otick == node->otick || node == NULL)
+ return node;
+ if (node != tree->root)
+ itree_validate (tree, node->parent);
+
+ itree_inherit_offset (tree->otick, node);
+ return node;
+}
+
+/* +=======================================================================+
+ * | Tree operations
+ * +=======================================================================+ */
+
+/* Initialize an allocated node. */
+
+void
+itree_node_init (struct itree_node *node,
+ bool front_advance, bool rear_advance,
+ Lisp_Object data)
+{
+ node->parent = NULL;
+ node->left = NULL;
+ node->right = NULL;
+ node->begin = -1;
+ node->end = -1;
+ node->front_advance = front_advance;
+ node->rear_advance = rear_advance;
+ node->data = data;
+}
+
+/* Return NODE's begin value, computing it if necessary. */
+
+ptrdiff_t
+itree_node_begin (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ itree_validate (tree, node);
+ return node->begin;
+}
+
+/* Return NODE's end value, computing it if necessary. */
+
+ptrdiff_t
+itree_node_end (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ itree_validate (tree, node);
+ return node->end;
+}
+
+/* Allocate an itree_tree. Free with itree_destroy. */
+
+struct itree_tree *
+itree_create (void)
+{
+ struct itree_tree *tree = xmalloc (sizeof (*tree));
+ itree_clear (tree);
+ return tree;
+}
+
+/* Reset the tree TREE to its empty state. */
+
+void
+itree_clear (struct itree_tree *tree)
+{
+ tree->root = NULL;
+ tree->otick = 1;
+ tree->size = 0;
+}
+
+#ifdef ITREE_TESTING
+/* Initialize a pre-allocated tree (presumably on the stack). */
+
+static void
+itree_init (struct itree_tree *tree)
+{
+ itree_clear (tree);
+}
+#endif
+
+/* Release a tree, freeing its allocated memory. */
+void
+itree_destroy (struct itree_tree *tree)
+{
+ eassert (tree->root == NULL);
+ xfree (tree);
+}
+
+/* Return the number of nodes in TREE. */
+
+intmax_t
+itree_size (struct itree_tree *tree)
+{
+ return tree->size;
+}
+
+/* Perform the familiar left-rotation on node NODE. */
+
+static void
+itree_rotate_left (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ eassert (node->right != NULL);
+
+ struct itree_node *right = node->right;
+
+ itree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, right);
+
+ /* Turn right's left subtree into node's right subtree. */
+ node->right = right->left;
+ if (right->left != NULL)
+ right->left->parent = node;
+
+ /* right's parent was node's parent. */
+ if (right != NULL)
+ right->parent = node->parent;
+
+ /* Get the parent to point to right instead of node. */
+ if (node != tree->root)
+ {
+ if (node == node->parent->left)
+ node->parent->left = right;
+ else
+ node->parent->right = right;
+ }
+ else
+ tree->root = right;
+
+ /* Put node on right's left. */
+ right->left = node;
+ if (node != NULL)
+ node->parent = right;
+
+ /* Order matters here. */
+ itree_update_limit (node);
+ itree_update_limit (right);
+}
+
+/* Perform the familiar right-rotation on node NODE. */
+
+static void
+itree_rotate_right (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ eassert (tree && node && node->left != NULL);
+
+ struct itree_node *left = node->left;
+
+ itree_inherit_offset (tree->otick, node);
+ itree_inherit_offset (tree->otick, left);
+
+ node->left = left->right;
+ if (left->right != NULL)
+ left->right->parent = node;
+
+ if (left != NULL)
+ left->parent = node->parent;
+ if (node != tree->root)
+ {
+ if (node == node->parent->right)
+ node->parent->right = left;
+ else
+ node->parent->left = left;
+ }
+ else
+ tree->root = left;
+
+ left->right = node;
+ if (node != NULL)
+ node->parent = left;
+
+ itree_update_limit (left);
+ itree_update_limit (node);
+}
+
+/* Repair the tree after an insertion.
+ The new NODE was added as red, so we may have 2 reds in a row.
+ Rebalance the parents as needed to re-establish the RB invariants. */
+
+static void
+itree_insert_fix (struct itree_tree *tree,
+ struct itree_node *node)
+{
+ eassert (tree->root->red == false);
+
+ while (null_safe_is_red (node->parent))
+ {
+ /* NODE is red and its parent is red. This is a violation of
+ red-black tree property #3. */
+ eassert (node->red);
+
+ if (node->parent == node->parent->parent->left)
+ {
+ /* We're on the left side of our grandparent, and OTHER is
+ our "uncle". */
+ struct itree_node *uncle = node->parent->parent->right;
+
+ if (null_safe_is_red (uncle)) /* case 1.a */
+ {
+ /* Uncle and parent are red but should be black because
+ NODE is red. Change the colors accordingly and
+ proceed with the grandparent. */
+ node->parent->red = false;
+ uncle->red = false;
+ node->parent->parent->red = true;
+ node = node->parent->parent;
+ }
+ else
+ {
+ /* Parent and uncle have different colors; parent is
+ red, uncle is black. */
+ if (node == node->parent->right) /* case 2.a */
+ {
+ node = node->parent;
+ itree_rotate_left (tree, node);
+ }
+ /* case 3.a */
+ node->parent->red = false;
+ node->parent->parent->red = true;
+ itree_rotate_right (tree, node->parent->parent);
+ }
+ }
+ else
+ {
+ /* This is the symmetrical case of above. */
+ struct itree_node *uncle = node->parent->parent->left;
+
+ if (null_safe_is_red (uncle)) /* case 1.b */
+ {
+ node->parent->red = false;
+ uncle->red = false;
+ node->parent->parent->red = true;
+ node = node->parent->parent;
+ }
+ else
+ {
+ if (node == node->parent->left) /* case 2.b */
+ {
+ node = node->parent;
+ itree_rotate_right (tree, node);
+ }
+ /* case 3.b */
+ node->parent->red = false;
+ node->parent->parent->red = true;
+ itree_rotate_left (tree, node->parent->parent);
+ }
+ }
+ }
+
+ /* The root may have been changed to red due to the algorithm.
+ Set it to black so that property #5 is satisfied. */
+ tree->root->red = false;
+ eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
+}
+
+/* Insert a NODE into the TREE.
+ Note, that inserting a node twice results in undefined behavior. */
+
+static void
+itree_insert_node (struct itree_tree *tree, struct itree_node *node)
+{
+ eassert (node && node->begin <= node->end);
+ eassert (node->left == NULL && node->right == NULL
+ && node->parent == NULL);
+ eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
+
+ struct itree_node *parent = NULL;
+ struct itree_node *child = tree->root;
+ uintmax_t otick = tree->otick;
+ /* It's the responsibility of the caller to set `otick` on the node,
+ to "confirm" that the begin/end fields are up to date. */
+ eassert (node->otick == otick);
+
+ /* Find the insertion point, accumulate node's offset and update
+ ancestors limit values. */
+ while (child != NULL)
+ {
+ itree_inherit_offset (otick, child);
+ parent = child;
+ eassert (child->offset == 0);
+ child->limit = max (child->limit, node->end);
+ /* This suggests that nodes in the right subtree are strictly
+ greater. But this is not true due to later rotations. */
+ child = node->begin <= child->begin ? child->left : child->right;
+ }
+
+ /* Insert the node */
+ if (parent == NULL)
+ tree->root = node;
+ else if (node->begin <= parent->begin)
+ parent->left = node;
+ else
+ parent->right = node;
+
+ /* Init the node */
+ node->parent = parent;
+ node->left = NULL;
+ node->right = NULL;
+ node->offset = 0;
+ node->limit = node->end;
+ eassert (node->parent == NULL || node->parent->otick >= node->otick);
+
+ /* Fix/update the tree */
+ ++tree->size;
+ if (node == tree->root)
+ node->red = false;
+ else
+ {
+ node->red = true;
+ eassert (check_tree (tree, false)); /* FIXME: Too expensive. */
+ itree_insert_fix (tree, node);
+ }
+}
+
+void
+itree_insert (struct itree_tree *tree, struct itree_node *node,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ node->begin = begin;
+ node->end = end;
+ node->otick = tree->otick;
+ itree_insert_node (tree, node);
+}
+
+/* Safely modify a node's interval. */
+
+void
+itree_node_set_region (struct itree_tree *tree,
+ struct itree_node *node,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ itree_validate (tree, node);
+ if (begin != node->begin)
+ {
+ itree_remove (tree, node);
+ node->begin = min (begin, PTRDIFF_MAX - 1);
+ node->end = max (node->begin, end);
+ itree_insert_node (tree, node);
+ }
+ else if (end != node->end)
+ {
+ node->end = max (node->begin, end);
+ eassert (node != NULL);
+ itree_propagate_limit (node);
+ }
+}
+
+/* Return true, if NODE is a member of TREE. */
+
+static bool
+itree_contains (struct itree_tree *tree, struct itree_node *node)
+{
+ eassert (node);
+ struct itree_node *other;
+ ITREE_FOREACH (other, tree, node->begin, PTRDIFF_MAX, ASCENDING)
+ if (other == node)
+ return true;
+
+ return false;
+}
+
+static bool
+itree_limit_is_stable (struct itree_node *node)
+{
+ if (node == NULL)
+ return true;
+ ptrdiff_t newlimit = itree_newlimit (node);
+ return (newlimit == node->limit);
+}
+
+static struct itree_node*
+itree_subtree_min (uintmax_t otick, struct itree_node *node)
+{
+ if (node == NULL)
+ return node;
+ while ((itree_inherit_offset (otick, node),
+ node->left != NULL))
+ node = node->left;
+ return node;
+}
+
+/* Repair the tree after a deletion.
+ The black-depth of NODE is one less than that of its sibling,
+ so re-balance the parents to re-establish the RB invariants. */
+
+static void
+itree_remove_fix (struct itree_tree *tree,
+ struct itree_node *node,
+ struct itree_node *parent)
+{
+ if (parent == NULL)
+ eassert (node == tree->root);
+ else
+ eassert (node == NULL || node->parent == parent);
+
+ while (parent != NULL && null_safe_is_black (node))
+ {
+ eassert (node == parent->left || node == parent->right);
+
+ if (node == parent->left)
+ {
+ struct itree_node *other = parent->right;
+
+ if (null_safe_is_red (other)) /* case 1.a */
+ {
+ other->red = false;
+ parent->red = true;
+ itree_rotate_left (tree, parent);
+ other = parent->right;
+ }
+ eassume (other != NULL);
+
+ if (null_safe_is_black (other->left) /* 2.a */
+ && null_safe_is_black (other->right))
+ {
+ other->red = true;
+ node = parent;
+ eassert (node != NULL);
+ parent = node->parent;
+ }
+ else
+ {
+ if (null_safe_is_black (other->right)) /* 3.a */
+ {
+ other->left->red = false;
+ other->red = true;
+ itree_rotate_right (tree, other);
+ other = parent->right;
+ }
+ other->red = parent->red; /* 4.a */
+ parent->red = false;
+ other->right->red = false;
+ itree_rotate_left (tree, parent);
+ node = tree->root;
+ parent = NULL;
+ }
+ }
+ else
+ {
+ struct itree_node *other = parent->left;
+
+ if (null_safe_is_red (other)) /* 1.b */
+ {
+ other->red = false;
+ parent->red = true;
+ itree_rotate_right (tree, parent);
+ other = parent->left;
+ }
+ eassume (other != NULL);
+
+ if (null_safe_is_black (other->right) /* 2.b */
+ && null_safe_is_black (other->left))
+ {
+ other->red = true;
+ node = parent;
+ eassert (node != NULL);
+ parent = node->parent;
+ }
+ else
+ {
+ if (null_safe_is_black (other->left)) /* 3.b */
+ {
+ other->right->red = false;
+ other->red = true;
+ itree_rotate_left (tree, other);
+ other = parent->left;
+ }
+
+ other->red = parent->red; /* 4.b */
+ parent->red = false;
+ other->left->red = false;
+ itree_rotate_right (tree, parent);
+ node = tree->root;
+ parent = NULL;
+ }
+ }
+ }
+
+ if (node != NULL)
+ node->red = false;
+}
+
+/* Return accumulated offsets of NODE's parents. */
+static ptrdiff_t
+itree_total_offset (struct itree_node *node)
+{
+ eassert (node != NULL);
+ ptrdiff_t offset = 0;
+ while (node->parent != NULL)
+ {
+ node = node->parent;
+ offset += node->offset;
+ }
+ return offset;
+}
+
+/* Replace DEST with SOURCE as a child of DEST's parent. Adjusts
+ *only* the parent linkage of SOURCE and either the parent's child
+ link the tree root.
+
+ Warning: DEST is left unmodified. SOURCE's child links are
+ unchanged. Caller is responsible for recalculation of `limit`.
+ Requires both nodes to be using the same effective `offset`. */
+static void
+itree_replace_child (struct itree_tree *tree,
+ struct itree_node *source,
+ struct itree_node *dest)
+{
+ eassert (tree && dest != NULL);
+ eassert (source == NULL
+ || itree_total_offset (source) == itree_total_offset (dest));
+
+ if (dest == tree->root)
+ tree->root = source;
+ else if (dest == dest->parent->left)
+ dest->parent->left = source;
+ else
+ dest->parent->right = source;
+
+ if (source != NULL)
+ source->parent = dest->parent;
+}
+/* Replace DEST with SOURCE in the tree. Copies the following fields
+ from DEST to SOURCE: red, parent, left, right. Also updates
+ parent, left and right in surrounding nodes to point to SOURCE.
+
+ Warning: DEST is left unmodified. Caller is responsible for
+ recalculation of `limit`. Requires both nodes to be using the same
+ effective `offset`. */
+static void
+itree_transplant (struct itree_tree *tree,
+ struct itree_node *source,
+ struct itree_node *dest)
+{
+ itree_replace_child (tree, source, dest);
+ source->left = dest->left;
+ if (source->left != NULL)
+ source->left->parent = source;
+ source->right = dest->right;
+ if (source->right != NULL)
+ source->right->parent = source;
+ source->red = dest->red;
+}
+
+/* Remove NODE from TREE and return it. NODE must exist in TREE. */
+
+struct itree_node*
+itree_remove (struct itree_tree *tree, struct itree_node *node)
+{
+ eassert (itree_contains (tree, node));
+ eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
+
+ /* Find `splice`, the leaf node to splice out of the tree. When
+ `node` has at most one child this is `node` itself. Otherwise,
+ it is the in order successor of `node`. */
+ itree_inherit_offset (tree->otick, node);
+ struct itree_node *splice
+ = (node->left == NULL || node->right == NULL)
+ ? node
+ : itree_subtree_min (tree->otick, node->right);
+
+ /* Find `subtree`, the only child of `splice` (may be NULL). Note:
+ `subtree` will not be modified other than changing its parent to
+ `splice`. */
+ eassert (splice->left == NULL || splice->right == NULL);
+ struct itree_node *subtree
+ = (splice->left != NULL) ? splice->left : splice->right;
+
+ /* Save a pointer to the parent of where `subtree` will eventually
+ be in `subtree_parent`. */
+ struct itree_node *subtree_parent
+ = (splice->parent != node) ? splice->parent : splice;
+
+ /* If `splice` is black removing it may violate Red-Black
+ invariants, so note this for later. */
+
+ /* Replace `splice` with `subtree` under subtree's parent. If
+ `splice` is black, this creates a red-red violation, so remember
+ this now as the field can be overwritten when splice is
+ transplanted below. */
+ itree_replace_child (tree, subtree, splice);
+ bool removed_black = !splice->red;
+
+ /* Replace `node` with `splice` in the tree and propagate limit
+ upwards, if necessary. Note: Limit propagation can stabilize at
+ any point, so we must call from bottom to top for every node that
+ has a new child. */
+ if (splice != node)
+ {
+ itree_transplant (tree, splice, node);
+ itree_propagate_limit (subtree_parent);
+ if (splice != subtree_parent)
+ itree_update_limit (splice);
+ }
+ itree_propagate_limit (splice->parent);
+
+ --tree->size;
+
+ /* Fix any black height violation caused by removing a black node. */
+ if (removed_black)
+ itree_remove_fix (tree, subtree, subtree_parent);
+
+ eassert ((tree->size == 0) == (tree->root == NULL));
+ eassert (check_tree (tree, true)); /* FIXME: Too expensive. */
+
+ /* Clear fields related to the tree for sanity while debugging. */
+ node->red = false;
+ node->right = node->left = node->parent = NULL;
+ node->limit = 0;
+
+ /* Must be clean (all offsets applied). Also, some callers rely on
+ node's otick being the tree's otick. */
+ eassert (node->otick == tree->otick);
+ eassert (node->offset == 0);
+
+ return node;
+}
+
+
+/* +=======================================================================+
+ * | Insert/Delete Gaps
+ * +=======================================================================+ */
+
+/* Insert a gap at POS of length LENGTH expanding all intervals
+ intersecting it, while respecting their rear_advance and
+ front_advance setting.
+
+ If BEFORE_MARKERS is non-zero, all overlays beginning/ending at POS
+ are treated as if their front_advance/rear_advance was true. */
+
+void
+itree_insert_gap (struct itree_tree *tree,
+ ptrdiff_t pos, ptrdiff_t length, bool before_markers)
+{
+ if (!tree || length <= 0 || tree->root == NULL)
+ return;
+ uintmax_t ootick = tree->otick;
+
+ /* FIXME: Don't allocate iterator/stack anew every time. */
+
+ /* Nodes with front_advance starting at pos may mess up the tree
+ order, so we need to remove them first. This doesn't apply for
+ `before_markers` since in that case, all positions move identically
+ regardless of `front_advance` or `rear_advance`. */
+ struct itree_stack *saved = itree_stack_create (0);
+ struct itree_node *node = NULL;
+ if (!before_markers)
+ {
+ /* Actually any order would do. */
+ ITREE_FOREACH (node, tree, pos, pos + 1, PRE_ORDER)
+ {
+ if (node->begin == pos && node->front_advance
+ /* If we have front_advance and !rear_advance and
+ the overlay is empty, make sure we don't move
+ begin past end by pretending it's !front_advance. */
+ && (node->begin != node->end || node->rear_advance))
+ itree_stack_push (saved, node);
+ }
+ }
+ for (size_t i = 0; i < saved->length; ++i)
+ itree_remove (tree, saved->nodes[i]);
+
+ /* We can't use an iterator here, because we can't effectively
+ narrow AND shift some subtree at the same time. */
+ if (tree->root != NULL)
+ {
+ const int size = itree_max_height (tree) + 1;
+ struct itree_stack *stack = itree_stack_create (size);
+ itree_stack_push (stack, tree->root);
+ while ((node = itree_stack_pop (stack)))
+ {
+ /* Process in pre-order. */
+ itree_inherit_offset (tree->otick, node);
+ if (pos > node->limit)
+ continue;
+ if (node->right != NULL)
+ {
+ if (node->begin > pos)
+ {
+ /* All nodes in this subtree are shifted by length. */
+ node->right->offset += length;
+ ++tree->otick;
+ }
+ else
+ itree_stack_push (stack, node->right);
+ }
+ if (node->left != NULL)
+ itree_stack_push (stack, node->left);
+
+ if (before_markers
+ ? node->begin >= pos
+ : node->begin > pos) /* node->begin == pos => !front-advance */
+ node->begin += length;
+ if (node->end > pos
+ || (node->end == pos && (before_markers || node->rear_advance)))
+ {
+ node->end += length;
+ eassert (node != NULL);
+ itree_propagate_limit (node);
+ }
+ }
+ itree_stack_destroy (stack);
+ }
+
+ /* Reinsert nodes starting at POS having front-advance. */
+ uintmax_t notick = tree->otick;
+ while ((node = itree_stack_pop (saved)))
+ {
+ eassert (node->otick == ootick);
+ eassert (node->begin == pos);
+ eassert (node->end > pos || node->rear_advance);
+ node->begin += length;
+ node->end += length;
+ node->otick = notick;
+ itree_insert_node (tree, node);
+ }
+
+ itree_stack_destroy (saved);
+}
+
+/* Delete a gap at POS of length LENGTH, contracting all intervals
+ intersecting it. */
+
+void
+itree_delete_gap (struct itree_tree *tree,
+ ptrdiff_t pos, ptrdiff_t length)
+{
+ if (!tree || length <= 0 || tree->root == NULL)
+ return;
+
+ /* FIXME: Don't allocate stack anew every time. */
+
+ /* Can't use the iterator here, because by decrementing begin, we
+ might unintentionally bring shifted nodes back into our search space. */
+ const int size = itree_max_height (tree) + 1;
+ struct itree_stack *stack = itree_stack_create (size);
+ struct itree_node *node;
+
+ itree_stack_push (stack, tree->root);
+ while ((node = itree_stack_pop (stack)))
+ {
+ itree_inherit_offset (tree->otick, node);
+ if (pos > node->limit)
+ continue;
+ if (node->right != NULL)
+ {
+ if (node->begin > pos + length)
+ {
+ /* Shift right subtree to the left. */
+ node->right->offset -= length;
+ ++tree->otick;
+ }
+ else
+ itree_stack_push (stack, node->right);
+ }
+ if (node->left != NULL)
+ itree_stack_push (stack, node->left);
+
+ if (pos < node->begin)
+ node->begin = max (pos, node->begin - length);
+ if (node->end > pos)
+ {
+ node->end = max (pos , node->end - length);
+ eassert (node != NULL);
+ itree_propagate_limit (node);
+ }
+ }
+ itree_stack_destroy (stack);
+}
+
+
+
+/* +=======================================================================+
+ * | Iterator
+ * +=======================================================================+ */
+
+/* Return true, if NODE's interval intersects with [BEGIN, END).
+ Note: We always include empty nodes at BEGIN (and not at END),
+ but if BEGIN==END, then we don't include non-empty nodes starting
+ at BEGIN or ending at END. This seems to match the behavior of the
+ old overlays code but it's not clear if it's The Right Thing
+ (e.g. it breaks the expectation that if NODE1 is included, then
+ a NODE2 strictly bigger than NODE1 should also be included). */
+
+static inline bool
+itree_node_intersects (const struct itree_node *node,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ return (begin < node->end && node->begin < end)
+ || (node->begin == node->end && begin == node->begin);
+}
+
+/* Return the "next" node in the current traversal order.
+
+ Note that this should return all the nodes that we need to traverse
+ in order to traverse the nodes selected by the current narrowing (i.e.
+ `ITER->begin..ITER->end`) so it will also return some nodes which aren't in
+ that narrowing simply because they may have children which are.
+
+ The code itself is very unsatifactory because the code of each one
+ of the supported traversals seems completely different from the others.
+ If someone knows how to make it more uniform and "obviously correct",
+ please make yourself heard. */
+
+static struct itree_node *
+itree_iter_next_in_subtree (struct itree_node *node,
+ struct itree_iterator *iter)
+{
+ /* FIXME: Like in the previous version of the iterator, we
+ prune based on `limit` only when moving to a left child,
+ but `limit` can also get smaller when moving to a right child
+ It's actually fairly common, so maybe it would be worthwhile
+ to prune a bit more aggressively here. */
+ struct itree_node *next;
+ switch (iter->order)
+ {
+ case ITREE_ASCENDING:
+ next = node->right;
+ if (!next)
+ {
+ while ((next = node->parent)
+ && next->right == node)
+ node = next;
+ if (!next)
+ return NULL; /* No more nodes to visit. */
+ node = next;
+ }
+ else
+ {
+ node = next;
+ itree_inherit_offset (iter->otick, node);
+ while ((next = node->left)
+ && (itree_inherit_offset (iter->otick, next),
+ iter->begin <= next->limit))
+ node = next;
+ }
+ if (node->begin > iter->end)
+ return NULL; /* No more nodes within begin..end. */
+ return node;
+
+ case ITREE_DESCENDING:
+ next = node->left;
+ if (!next
+ || (itree_inherit_offset (iter->otick, next),
+ next->limit < iter->begin))
+ {
+ while ((next = node->parent)
+ && next->left == node)
+ node = next;
+ if (!next)
+ return NULL; /* No more nodes to visit. */
+ node = next;
+ }
+ else
+ {
+ node = next;
+ while (node->begin <= iter->end
+ && (next = node->right))
+ {
+ itree_inherit_offset (iter->otick, next),
+ node = next;
+ }
+ }
+ return node;
+
+ case ITREE_PRE_ORDER:
+ next = node->left;
+ if (next
+ && (itree_inherit_offset (iter->otick, next),
+ !(next->limit < iter->begin)))
+ return next;
+ next = node->right;
+ if (node->begin <= iter->end && next)
+ {
+ itree_inherit_offset (iter->otick, next);
+ return next;
+ }
+ while ((next = node->parent))
+ {
+ if (next->right == node)
+ node = next;
+ else
+ {
+ eassert (next->left == node);
+ node = next;
+ next = node->right;
+ if (node->begin <= iter->end && next)
+ {
+ itree_inherit_offset (iter->otick, next);
+ return next;
+ }
+ }
+ }
+ return NULL;
+
+ case ITREE_POST_ORDER:
+ next = node->parent;
+ if (!next || next->right == node)
+ return next;
+ eassert (next->left == node);
+ node = next;
+ next = node->right;
+ if (!(node->begin <= iter->end && next))
+ return node;
+ node = next;
+ itree_inherit_offset (iter->otick, node);
+ while (((next = node->left)
+ && (itree_inherit_offset (iter->otick, next),
+ iter->begin <= next->limit))
+ || (node->begin <= iter->end
+ && (next = node->right)
+ && (itree_inherit_offset (iter->otick, next), true)))
+ node = next;
+ return node;
+
+ default:
+ emacs_abort ();
+ }
+}
+
+static struct itree_node *
+itree_iterator_first_node (struct itree_tree *tree,
+ struct itree_iterator *iter)
+{
+ struct itree_node *node = tree->root;
+ if (node)
+ {
+ struct itree_node dummy;
+ dummy.left = NULL;
+ dummy.parent = NULL;
+ dummy.right = NULL;
+ itree_inherit_offset (iter->otick, node);
+ switch (iter->order)
+ {
+ case ITREE_ASCENDING:
+ dummy.right = node;
+ dummy.begin = PTRDIFF_MIN;
+ node = itree_iter_next_in_subtree (&dummy, iter);
+ break;
+
+ case ITREE_DESCENDING:
+ dummy.left = node;
+ node = itree_iter_next_in_subtree (&dummy, iter);
+ break;
+
+ case ITREE_PRE_ORDER:
+ break;
+
+ case ITREE_POST_ORDER:
+ dummy.parent = &dummy;
+ dummy.left = &dummy;
+ dummy.right = node;
+ dummy.begin = PTRDIFF_MIN;
+ node = itree_iter_next_in_subtree (&dummy, iter);
+ break;
+ default:
+ emacs_abort ();
+ }
+ }
+ return node;
+}
+
+/* Start a iterator enumerating all intervals in [BEGIN,END) in the
+ given ORDER. */
+
+struct itree_iterator *
+itree_iterator_start (struct itree_iterator *iter,
+ struct itree_tree *tree,
+ ptrdiff_t begin, ptrdiff_t end, enum itree_order order)
+{
+ eassert (iter);
+ iter->begin = begin;
+ iter->end = end;
+ iter->otick = tree->otick;
+ iter->order = order;
+ /* Beware: the `node` field always holds "the next" node to consider.
+ so it's always "one node ahead" of what the iterator loop sees.
+ In most respects this makes no difference, but we depend on this
+ detail in `delete_all_overlays` where this allows us to modify
+ the current node knowing that the iterator will not need it to
+ find the next. */
+ iter->node = itree_iterator_first_node (tree, iter);
+ return iter;
+}
+
+struct itree_node *
+itree_iterator_next (struct itree_iterator *iter)
+{
+ struct itree_node *node = iter->node;
+ while (node
+ && !itree_node_intersects (node, iter->begin, iter->end))
+ {
+ node = itree_iter_next_in_subtree (node, iter);
+ eassert (itree_limit_is_stable (node));
+ }
+ iter->node = node ? itree_iter_next_in_subtree (node, iter) : NULL;
+ return node;
+}
+
+/* Limit G to the new interval [BEGIN, END), which must be a subset of
+ the current one. I.E. it can't grow on either side. */
+
+void
+itree_iterator_narrow (struct itree_iterator *g,
+ ptrdiff_t begin, ptrdiff_t end)
+{
+ eassert (g);
+ eassert (begin >= g->begin);
+ eassert (end <= g->end);
+ g->begin = max (begin, g->begin);
+ g->end = min (end, g->end);
+}
diff --git a/src/itree.h b/src/itree.h
new file mode 100644
index 0000000000..291fa53fd3
--- /dev/null
+++ b/src/itree.h
@@ -0,0 +1,181 @@
+/* This file implements an efficient interval data-structure.
+
+Copyright (C) 2017-2022 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 <http://www.gnu.org/licenses/>. */
+
+#ifndef ITREE_H
+#define ITREE_H
+#include <config.h>
+#include <stddef.h>
+#include <inttypes.h>
+
+#include "lisp.h"
+
+/* The tree and node structs are mainly here, so they can be
+ allocated.
+
+ NOTE: The only time where it is safe to modify node.begin and
+ node.end directly, is while the node is not part of any tree.
+
+ NOTE: It is safe to read node.begin and node.end directly, if the
+ node came from an iterator, because it validates the nodes it
+ returns as a side-effect. See ITREE_FOREACH.
+ */
+
+struct itree_node
+{
+ /* The normal parent, left and right links found in binary trees.
+ See also `red`, below, which completes the Red-Black tree
+ representation. */
+ struct itree_node *parent;
+ struct itree_node *left;
+ struct itree_node *right;
+
+ /* The following five fields comprise the interval abstraction.
+
+ BEGIN, END are buffer positions describing the range. When a
+ node is in a tree these fields are read only, written only by
+ itree functions.
+
+ The LIMIT, OFFSET and OTICK fields should be considered internal
+ to itree.c and used only by itree functions.
+
+ LIMIT is a buffer position, the maximum of END of this node and
+ its children. See itree.c for its use.
+
+ OFFSET is in buffer position units, and will be non-zero only
+ when the node is dirty.
+
+ OTICK determines whether BEGIN, END, LIMIT and OFFSET are
+ considered dirty. A node is clean when its OTICK is equal to the
+ OTICK of its tree (see struct itree_tree). Otherwise, it is
+ dirty.
+
+ In a clean node, BEGIN, END and LIMIT are correct buffer
+ positions, and OFFSET is zero. The parent of a clean node is
+ also clean, recursively.
+
+ In a dirty node, the node's OTICK won't equal its tree's OTICK,
+ and its OFFSET may be non-zero. At all times the descendents of
+ a dirty node are also dirty. BEGIN, END and LIMIT require
+ adjustment before use as buffer positions.
+
+ NOTE: BEGIN and END must not be modified while the node is part
+ of a tree. Use itree_insert_gap and itree_delete_gap instead.
+
+ NOTE: The interval iterators ensure nodes are clean before
+ yielding them, so BEGIN and END may be safely used as buffer
+ positions then. */
+
+ ptrdiff_t begin; /* The beginning of this interval. */
+ ptrdiff_t end; /* The end of the interval. */
+ ptrdiff_t limit; /* The maximum end in this subtree. */
+ ptrdiff_t offset; /* The amount of shift to apply to this
subtree. */
+ uintmax_t otick; /* offset modified tick */
+ Lisp_Object data; /* Exclusively used by the client. */
+ bool_bf red : 1;
+ bool_bf rear_advance : 1; /* Same as for marker and overlays. */
+ bool_bf front_advance : 1; /* Same as for marker and overlays. */
+};
+
+struct itree_tree
+{
+ struct itree_node *root;
+ uintmax_t otick; /* offset tick, compared with node's otick. */
+ intmax_t size; /* Number of nodes in the tree. */
+};
+
+enum itree_order
+ {
+ ITREE_ASCENDING,
+ ITREE_DESCENDING,
+ ITREE_PRE_ORDER,
+ ITREE_POST_ORDER,
+ };
+
+extern void itree_node_init (struct itree_node *, bool, bool, Lisp_Object);
+extern ptrdiff_t itree_node_begin (struct itree_tree *, struct itree_node *);
+extern ptrdiff_t itree_node_end (struct itree_tree *, struct itree_node *);
+extern void itree_node_set_region (struct itree_tree *, struct itree_node *,
+ ptrdiff_t, ptrdiff_t);
+extern struct itree_tree *itree_create (void);
+extern void itree_destroy (struct itree_tree *);
+extern intmax_t itree_size (struct itree_tree *);
+extern void itree_clear (struct itree_tree *);
+extern void itree_insert (struct itree_tree *, struct itree_node *,
+ ptrdiff_t, ptrdiff_t);
+extern struct itree_node *itree_remove (struct itree_tree *,
+ struct itree_node *);
+extern void itree_insert_gap (struct itree_tree *, ptrdiff_t, ptrdiff_t, bool);
+extern void itree_delete_gap (struct itree_tree *, ptrdiff_t, ptrdiff_t);
+
+/* Iteration functions. Almost all code should use ITREE_FOREACH
+ instead. */
+extern struct itree_iterator *itree_iterator_start (struct itree_iterator *,
+ struct itree_tree *,
+ ptrdiff_t,
+ ptrdiff_t,
+ enum itree_order);
+extern void itree_iterator_narrow (struct itree_iterator *, ptrdiff_t,
+ ptrdiff_t);
+extern struct itree_node *itree_iterator_next (struct itree_iterator *);
+
+/* State used when iterating interval. */
+struct itree_iterator
+ {
+ struct itree_node *node;
+ ptrdiff_t begin;
+ ptrdiff_t end;
+ uintmax_t otick; /* A copy of the tree's `otick`. */
+ enum itree_order order;
+ };
+
+/* Iterate over the intervals between BEG and END in the tree T.
+ N will hold successive nodes. ORDER can be one of : `ASCENDING`,
+ `DESCENDING`, `POST_ORDER`, or `PRE_ORDER`.
+ It should be used as:
+
+ ITREE_FOREACH (n, t, beg, end, order)
+ {
+ .. do the thing with n ..
+ }
+
+ BEWARE:
+ - The expression T may be evaluated more than once, so make sure
+ it is cheap and pure.
+ - Don't modify the tree during the iteration.
+ */
+#define ITREE_FOREACH(n, t, beg, end, order) \
+ /* FIXME: We'd want to declare `n` right here, but I can't figure out
+ how to make that work here: the `for` syntax only allows a single
+ clause for the var declarations where we need 2 different types.
+ We could use the `struct {foo x; bar y; } p;` trick to declare two
+ vars `p.x` and `p.y` of unrelated types, but then none of the names
+ of the vars matches the `n` we receive :-(. */ \
+ if (!t) \
+ { } \
+ else \
+ for (struct itree_iterator itree_local_iter_, \
+ *itree_iter_ \
+ = itree_iterator_start (&itree_local_iter_, \
+ t, beg, end, ITREE_##order); \
+ ((n = itree_iterator_next (itree_iter_)));)
+
+#define ITREE_FOREACH_NARROW(beg, end) \
+ itree_iterator_narrow (itree_iter_, beg, end)
+
+#endif
diff --git a/src/keyboard.c b/src/keyboard.c
index 8ab4a451b4..811998823c 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -503,9 +503,11 @@ echo_add_key (Lisp_Object c)
if ((NILP (echo_string) || SCHARS (echo_string) == 0)
&& help_char_p (c))
{
- AUTO_STRING (str, " (Type ? for further options)");
+ AUTO_STRING (str, " (Type ? for further options, q for quick help)");
AUTO_LIST2 (props, Qface, Qhelp_key_binding);
Fadd_text_properties (make_fixnum (7), make_fixnum (8), props, str);
+ Fadd_text_properties (make_fixnum (30), make_fixnum (31), props,
+str);
new_string = concat2 (new_string, str);
}
@@ -1268,7 +1270,6 @@ command_loop_1 (void)
{
modiff_count prev_modiff = 0;
struct buffer *prev_buffer = NULL;
- bool already_adjusted = 0;
kset_prefix_arg (current_kboard, Qnil);
kset_last_prefix_arg (current_kboard, Qnil);
@@ -1458,8 +1459,6 @@ command_loop_1 (void)
safe_run_hooks_maybe_narrowed (Qpre_command_hook,
XWINDOW (selected_window));
- already_adjusted = 0;
-
if (NILP (Vthis_command))
/* nil means key is undefined. */
call0 (Qundefined);
@@ -1615,9 +1614,8 @@ command_loop_1 (void)
the automatic composition, we must update the
display. */
windows_or_buffers_changed = 21;
- if (!already_adjusted)
- adjust_point_for_property (last_point_position,
- MODIFF != prev_modiff);
+ adjust_point_for_property (last_point_position,
+ MODIFF != prev_modiff);
}
else if (PT > BEGV && PT < ZV
&& (composition_adjust_point (last_point_position, PT)
@@ -1699,8 +1697,8 @@ adjust_point_for_property (ptrdiff_t last_pt, bool
modified)
&& display_prop_intangible_p (val, overlay, PT, PT_BYTE)
&& (!OVERLAYP (overlay)
? get_property_and_range (PT, Qdisplay, &val, &beg, &end, Qnil)
- : (beg = OVERLAY_POSITION (OVERLAY_START (overlay)),
- end = OVERLAY_POSITION (OVERLAY_END (overlay))))
+ : (beg = OVERLAY_START (overlay),
+ end = OVERLAY_END (overlay)))
&& (beg < PT /* && end > PT <- It's always the case. */
|| (beg <= PT && STRINGP (val) && SCHARS (val) == 0)))
{
@@ -5722,6 +5720,29 @@ make_scroll_bar_position (struct input_event *ev,
Lisp_Object type)
builtin_lisp_symbol (scroll_bar_parts[ev->part]));
}
+#if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR
+
+/* Return whether or not the coordinates X and Y are inside the
+ box of the menu-bar window of frame F. */
+
+static bool
+coords_in_menu_bar_window (struct frame *f, int x, int y)
+{
+ struct window *window;
+
+ if (!WINDOWP (f->menu_bar_window))
+ return false;
+
+ window = XWINDOW (f->menu_bar_window);
+
+ return (y >= WINDOW_TOP_EDGE_Y (window)
+ && x >= WINDOW_LEFT_EDGE_X (window)
+ && y <= WINDOW_BOTTOM_EDGE_Y (window)
+ && x <= WINDOW_RIGHT_EDGE_X (window));
+}
+
+#endif
+
/* Given a struct input_event, build the lisp event which represents
it. If EVENT is 0, build a mouse movement event from the mouse
movement buffer, which should have a movement event in it.
@@ -5974,10 +5995,32 @@ make_lispy_event (struct input_event *event)
and ROW are set to frame relative glyph coordinates
which are then used to determine whether this click is
in a menu (non-toolkit version). */
- if (!toolkit_menubar_in_use (f))
+ if (!toolkit_menubar_in_use (f)
+#if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR
+ /* Don't process events for menu bars if they are not
+ in the menu bar window. */
+ && (!FRAME_WINDOW_P (f)
+ || coords_in_menu_bar_window (f, XFIXNUM (event->x),
+ XFIXNUM (event->y)))
+#endif
+ )
{
- pixel_to_glyph_coords (f, XFIXNUM (event->x), XFIXNUM
(event->y),
- &column, &row, NULL, 1);
+#if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR
+ if (FRAME_WINDOW_P (f))
+ {
+ struct window *menu_w = XWINDOW (f->menu_bar_window);
+ int x, y, dummy;
+
+ x = FRAME_TO_WINDOW_PIXEL_X (menu_w, XFIXNUM (event->x));
+ y = FRAME_TO_WINDOW_PIXEL_Y (menu_w, XFIXNUM (event->y));
+
+ x_y_to_hpos_vpos (XWINDOW (f->menu_bar_window), x, y,
&column, &row,
+ NULL, NULL, &dummy);
+ }
+ else
+#endif
+ pixel_to_glyph_coords (f, XFIXNUM (event->x), XFIXNUM
(event->y),
+ &column, &row, NULL, 1);
/* In the non-toolkit version, clicks on the menu bar
are ordinary button events in the event buffer.
@@ -5987,7 +6030,7 @@ make_lispy_event (struct input_event *event)
menu bar and Emacs doesn't know about it until
after the user makes a selection.) */
if (row >= 0 && row < FRAME_MENU_BAR_LINES (f)
- && (event->modifiers & down_modifier))
+ && (event->modifiers & down_modifier))
{
Lisp_Object items, item;
diff --git a/src/lisp.h b/src/lisp.h
index 9f497d9227..6a24a53817 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -1,7 +1,6 @@
/* Fundamental definitions for GNU Emacs Lisp interpreter. -*- coding: utf-8
-*-
-Copyright (C) 1985-1987, 1993-1995, 1997-2022 Free Software Foundation,
-Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -645,10 +644,8 @@ extern bool initialized;
extern struct gflags
{
/* True means this Emacs instance was born to dump. */
-#if defined HAVE_PDUMPER || defined HAVE_UNEXEC
bool will_dump_ : 1;
bool will_bootstrap_ : 1;
-#endif
#ifdef HAVE_PDUMPER
/* Set in an Emacs process that will likely dump with pdumper; all
Emacs processes may dump with pdumper, however. */
@@ -1580,10 +1577,15 @@ struct Lisp_String
{
struct
{
- ptrdiff_t size; /* MSB is used as the markbit. */
- ptrdiff_t size_byte; /* Set to -1 for unibyte strings,
- -2 for data in rodata,
- -3 for immovable unibyte strings. */
+ /* Number of characters in string; MSB is used as the mark bit. */
+ ptrdiff_t size;
+ /* If nonnegative, number of bytes in the string (which is multibyte).
+ If negative, the string is unibyte:
+ -1 for data normally allocated
+ -2 for data in rodata (C string constants)
+ -3 for data that must be immovable (used for bytecode) */
+ ptrdiff_t size_byte;
+
INTERVAL intervals; /* Text properties in this string. */
unsigned char *data;
} s;
@@ -2608,10 +2610,9 @@ struct Lisp_Overlay
*/
{
union vectorlike_header header;
- Lisp_Object start;
- Lisp_Object end;
Lisp_Object plist;
- struct Lisp_Overlay *next;
+ struct buffer *buffer; /* eassert (live buffer || NULL). */
+ struct itree_node *interval;
} GCALIGNED_STRUCT;
struct Lisp_Misc_Ptr
@@ -3187,10 +3188,11 @@ CHECK_SUBR (Lisp_Object x)
`minargs' should be a number, the minimum number of arguments allowed.
`maxargs' should be a number, the maximum number of arguments allowed,
or else MANY or UNEVALLED.
- MANY means pass a vector of evaluated arguments,
- in the form of an integer number-of-arguments
- followed by the address of a vector of Lisp_Objects
- which contains the argument values.
+ MANY means there are &rest arguments. Here we pass a vector
+ of evaluated arguments in the form of an integer
+ number-of-arguments followed by the address of a vector of
+ Lisp_Objects which contains the argument values. (We also use
+ this convention when calling a subr with more than 8 parameters.)
UNEVALLED means pass the list of unevaluated arguments
`intspec' says how interactive arguments are to be fetched.
If the string starts with a `(', `intspec' is evaluated and the resulting
@@ -4422,7 +4424,6 @@ extern Lisp_Object make_float (double);
extern void display_malloc_warning (void);
extern specpdl_ref inhibit_garbage_collection (void);
extern Lisp_Object build_symbol_with_pos (Lisp_Object, Lisp_Object);
-extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
extern void free_cons (struct Lisp_Cons *);
extern void init_alloc_once (void);
extern void init_alloc (void);
@@ -4694,7 +4695,7 @@ extern void syms_of_editfns (void);
extern bool mouse_face_overlay_overlaps (Lisp_Object);
extern Lisp_Object disable_line_numbers_overlay_at_eob (void);
extern AVOID nsberror (Lisp_Object);
-extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t);
+extern void adjust_overlays_for_insert (ptrdiff_t, ptrdiff_t, bool);
extern void adjust_overlays_for_delete (ptrdiff_t, ptrdiff_t);
extern void fix_start_end_in_overlays (ptrdiff_t, ptrdiff_t);
extern void report_overlay_modification (Lisp_Object, Lisp_Object, bool,
@@ -4807,7 +4808,7 @@ extern void clear_regexp_cache (void);
extern Lisp_Object Vminibuffer_list;
extern Lisp_Object last_minibuf_string;
-extern void move_minibuffers_onto_frame (struct frame *, bool);
+extern void move_minibuffers_onto_frame (struct frame *, Lisp_Object, bool);
extern bool is_minibuffer (EMACS_INT, Lisp_Object);
extern EMACS_INT this_minibuffer_depth (Lisp_Object);
extern EMACS_INT minibuf_level;
@@ -4934,6 +4935,7 @@ extern bool running_asynch_code;
/* Defined in process.c. */
struct Lisp_Process;
+extern void child_signal_init (void);
extern void kill_buffer_processes (Lisp_Object);
extern int wait_reading_process_output (intmax_t, int, int, bool, Lisp_Object,
struct Lisp_Process *, int);
diff --git a/src/lread.c b/src/lread.c
index 37ee3a00ec..0a6e4201e4 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1236,7 +1236,8 @@ Return t if the file exists and loads successfully. */)
/* If file name is magic, call the handler. */
handler = Ffind_file_name_handler (file, Qload);
if (!NILP (handler))
- return call5 (handler, Qload, file, noerror, nomessage, nosuffix);
+ return
+ call6 (handler, Qload, file, noerror, nomessage, nosuffix, must_suffix);
/* The presence of this call is the result of a historical accident:
it used to be in every file-operation and when it got removed
@@ -1740,12 +1741,15 @@ maybe_swap_for_eln (bool no_native, Lisp_Object
*filename, int *fd,
Vload_path,
Qnil, Qnil)))
return;
- call2 (intern_c_string ("display-warning"),
- Qcomp,
- CALLN (Fformat,
- build_string ("Cannot look up eln file as "
- "no source file was found for %s"),
- *filename));
+ Vdelayed_warnings_list
+ = Fcons (list2
+ (Qcomp,
+ CALLN (Fformat,
+ build_string ("Cannot look up eln "
+ "file as no source file "
+ "was found for %s"),
+ *filename)),
+ Vdelayed_warnings_list);
return;
}
}
@@ -5627,7 +5631,8 @@ from the file, and matches them against this regular
expression.
When the regular expression matches, the file is considered to be safe
to load. */);
Vbytecomp_version_regexp
- = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version
FSF\\)");
+ = build_pure_c_string
+ ("^;;;.\\(?:in Emacs version\\|bytecomp version FSF\\)");
DEFSYM (Qlexical_binding, "lexical-binding");
DEFVAR_LISP ("lexical-binding", Vlexical_binding,
diff --git a/src/menu.c b/src/menu.c
index c52e9258a1..a8cb942a19 100644
--- a/src/menu.c
+++ b/src/menu.c
@@ -24,6 +24,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "lisp.h"
#include "character.h"
#include "coding.h"
+#include "dispextern.h"
#include "keyboard.h"
#include "keymap.h"
#include "frame.h"
@@ -1391,6 +1392,17 @@ x_popup_menu_1 (Lisp_Object position, Lisp_Object menu)
run_hook (Qx_pre_popup_menu_hook);
+#ifdef HAVE_WINDOW_SYSTEM
+ /* Cancel the hourglass timer. Depending on how the show_menu_hook
+ is implemented, the hourglass window can either be mapped (or on
+ non-X systems, the hourglass cursor can be defined) either while
+ the menu is active, or while it is deactivated. Both situations
+ lead to annoying cursor and/or screen flicker and a failure to
+ detect input immediately after a popup menu generated by Custom
+ is unmapped. */
+ cancel_hourglass ();
+#endif
+
/* Display them in a menu, but not if F is the initial frame that
doesn't have its hooks set (e.g., in a batch session), because
such a frame cannot display menus. */
diff --git a/src/minibuf.c b/src/minibuf.c
index bedc564480..3f34b1b083 100644
--- a/src/minibuf.c
+++ b/src/minibuf.c
@@ -187,13 +187,15 @@ zip_minibuffer_stacks (Lisp_Object dest_window,
Lisp_Object source_window)
/* If `minibuffer_follows_selected_frame' is t, or we're about to
delete a frame which potentially "contains" minibuffers, move them
- from the old frame to the selected frame. This function is
+ from the old frame to the to-be-selected frame. This function is
intended to be called from `do_switch_frame' in frame.c. OF is the
- old frame, FOR_DELETION is true if OF is about to be deleted. */
+ old frame, FRAME is the to-be-selected frame, and FOR_DELETION is true
+ if OF is about to be deleted. */
void
-move_minibuffers_onto_frame (struct frame *of, bool for_deletion)
+move_minibuffers_onto_frame (struct frame *of, Lisp_Object frame,
+ bool for_deletion)
{
- struct frame *f = XFRAME (selected_frame);
+ struct frame *f = XFRAME (frame);
minibuf_window = f->minibuffer_window;
if (!(minibuf_level
@@ -206,7 +208,7 @@ move_minibuffers_onto_frame (struct frame *of, bool
for_deletion)
{
zip_minibuffer_stacks (f->minibuffer_window, of->minibuffer_window);
if (for_deletion && XFRAME (MB_frame) != of)
- MB_frame = selected_frame;
+ MB_frame = frame;
}
}
diff --git a/src/msdos.h b/src/msdos.h
index 24697bcf24..1b304cf02b 100644
--- a/src/msdos.h
+++ b/src/msdos.h
@@ -123,7 +123,6 @@ extern void x_set_menu_bar_lines (struct frame *,
Lisp_Object, Lisp_Object);
#define XGetGeometry(p1,p2,p3,p4,p5,p6,p7,p8,p9)
#define DisplayWidth(p1,p2) (SELECTED_FRAME()->text_cols)
#define DisplayHeight(p1,p2) (SELECTED_FRAME()->text_lines)
-#define XMenuSetAEQ (void)
#define XMenuSetFreeze (void)
#define XMenuRecompute (void)
#define XM_FAILURE -1
diff --git a/src/nsfns.m b/src/nsfns.m
index 2699cf37a5..d793bcf13f 100644
--- a/src/nsfns.m
+++ b/src/nsfns.m
@@ -632,10 +632,19 @@ ns_set_menu_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
ns_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
diff --git a/src/nsimage.m b/src/nsimage.m
index 9cb5090dd0..dd8768664a 100644
--- a/src/nsimage.m
+++ b/src/nsimage.m
@@ -74,8 +74,10 @@ ns_can_use_native_image_api (Lisp_Object type)
imageType = @"com.compuserve.gif";
else if (EQ (type, Qtiff))
imageType = @"public.tiff";
+#ifndef HAVE_RSVG
else if (EQ (type, Qsvg))
imageType = @"public.svg-image";
+#endif
else if (EQ (type, Qheic))
imageType = @"public.heic";
diff --git a/src/nsterm.m b/src/nsterm.m
index 82fe58e90e..507f2a9e7d 100644
--- a/src/nsterm.m
+++ b/src/nsterm.m
@@ -2479,7 +2479,7 @@ get_keysym_name (int keysym)
{
static char value[16];
NSTRACE ("get_keysym_name");
- sprintf (value, "%d", keysym);
+ snprintf (value, 16, "%d", keysym);
return value;
}
@@ -4237,7 +4237,12 @@ ns_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
for (i = 0; i < s->nchars; i++, glyph++)
{
- char buf[7];
+#ifdef GCC_LINT
+ enum { PACIFY_GCC_BUG_81401 = 1 };
+#else
+ enum { PACIFY_GCC_BUG_81401 = 0 };
+#endif
+ char buf[8 + PACIFY_GCC_BUG_81401];
char *str = NULL;
int len = glyph->u.glyphless.len;
@@ -4263,7 +4268,7 @@ ns_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
{
unsigned int ch = glyph->u.glyphless.ch;
eassume (ch <= MAX_CHAR);
- sprintf (buf, "%0*X", ch < 0x10000 ? 4 : 6, ch);
+ snprintf (buf, 8, "%0*X", ch < 0x10000 ? 4 : 6, ch);
str = buf;
}
@@ -6116,17 +6121,20 @@ ns_term_shutdown (int sig)
- (void) terminate: (id)sender
{
+ struct input_event ie;
+ struct frame *f;
+
NSTRACE ("[EmacsApp terminate:]");
- struct frame *emacsframe = SELECTED_FRAME ();
+ f = SELECTED_FRAME ();
+ EVENT_INIT (ie);
- if (!emacs_event)
- return;
+ ie.kind = NS_NONKEY_EVENT;
+ ie.code = KEY_NS_POWER_OFF;
+ ie.arg = Qt; /* mark as non-key event */
+ XSETFRAME (ie.frame_or_window, f);
- emacs_event->kind = NS_NONKEY_EVENT;
- emacs_event->code = KEY_NS_POWER_OFF;
- emacs_event->arg = Qt; /* mark as non-key event */
- EV_TRAILER ((id)nil);
+ kbd_buffer_store_event (&ie);
}
static bool
@@ -7048,6 +7056,36 @@ ns_create_font_panel_buttons (id target, SEL select, SEL
cancel_action)
processingCompose = NO;
}
+static Lisp_Object
+ns_in_echo_area_1 (void *ptr)
+{
+ Lisp_Object in_echo_area;
+ specpdl_ref count;
+
+ count = SPECPDL_INDEX ();
+ specbind (Qinhibit_quit, Qt);
+ in_echo_area = safe_call (1, Qns_in_echo_area);
+
+ return unbind_to (count, in_echo_area);
+}
+
+static Lisp_Object
+ns_in_echo_area_2 (enum nonlocal_exit exit, Lisp_Object error)
+{
+ return Qnil;
+}
+
+static bool
+ns_in_echo_area (void)
+{
+ Lisp_Object in_echo_area;
+
+ in_echo_area
+ = internal_catch_all (ns_in_echo_area_1, NULL,
+ ns_in_echo_area_2);
+
+ return !NILP (in_echo_area);
+}
/* Used to position char selection windows, etc. */
- (NSRect)firstRectForCharacterRange: (NSRange)theRange
@@ -7061,7 +7099,7 @@ ns_create_font_panel_buttons (id target, SEL select, SEL
cancel_action)
if (NS_KEYLOG)
NSLog (@"firstRectForCharRange request");
- if (WINDOWP (echo_area_window) && ! NILP (call0 (intern
("ns-in-echo-area"))))
+ if (WINDOWP (echo_area_window) && ns_in_echo_area ())
win = XWINDOW (echo_area_window);
else
win = XWINDOW (FRAME_SELECTED_WINDOW (emacsframe));
@@ -8593,7 +8631,7 @@ ns_create_font_panel_buttons (id target, SEL select, SEL
cancel_action)
EmacsLayer *layer = (EmacsLayer *)[self layer];
[layer setContentsScale:[[notification object] backingScaleFactor]];
- [layer setColorSpace:[[[notification object] colorSpace] CGColorSpace]];
+ [layer setColorSpace:[(id) [[notification object] colorSpace] CGColorSpace]];
ns_clear_frame (emacsframe);
expose_frame (emacsframe, 0, 0, NSWidth (frame), NSHeight (frame));
@@ -9155,6 +9193,7 @@ ns_create_font_panel_buttons (id target, SEL select, SEL
cancel_action)
NSTRACE ("[EmacsWindow dealloc]");
/* We need to release the toolbar ourselves. */
+ [self setToolbar: nil];
[[self toolbar] release];
/* Also the last button press event . */
@@ -11003,6 +11042,7 @@ respectively. */);
DEFSYM (Qcondensed, "condensed");
DEFSYM (Qreverse_italic, "reverse-italic");
DEFSYM (Qexpanded, "expanded");
+ DEFSYM (Qns_in_echo_area, "ns-in-echo-area");
#ifdef NS_IMPL_COCOA
Fprovide (Qcocoa, Qnil);
diff --git a/src/pdumper.c b/src/pdumper.c
index 903298f17d..0a5d96dbb7 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -2067,7 +2067,7 @@ dump_interval_tree (struct dump_context *ctx,
static dump_off
dump_string (struct dump_context *ctx, const struct Lisp_String *string)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_String_C2CAF90352)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_String_03B2DF1C8E)
# error "Lisp_String changed. See CHECK_STRUCTS comment in config.h."
#endif
/* If we have text properties, write them _after_ the string so that
@@ -2133,17 +2133,64 @@ dump_marker (struct dump_context *ctx, const struct
Lisp_Marker *marker)
return finish_dump_pvec (ctx, &out->header);
}
+static dump_off
+dump_interval_node (struct dump_context *ctx, struct itree_node *node,
+ dump_off parent_offset)
+{
+#if CHECK_STRUCTS && !defined (HASH_itree_node_50DE304F13)
+# error "itree_node changed. See CHECK_STRUCTS comment in config.h."
+#endif
+ struct itree_node out;
+ dump_object_start (ctx, &out, sizeof (out));
+ if (node->parent)
+ dump_field_fixup_later (ctx, &out, node, &node->parent);
+ if (node->left)
+ dump_field_fixup_later (ctx, &out, node, &node->parent);
+ if (node->right)
+ dump_field_fixup_later (ctx, &out, node, &node->parent);
+ DUMP_FIELD_COPY (&out, node, begin);
+ DUMP_FIELD_COPY (&out, node, end);
+ DUMP_FIELD_COPY (&out, node, limit);
+ DUMP_FIELD_COPY (&out, node, offset);
+ DUMP_FIELD_COPY (&out, node, otick);
+ dump_field_lv (ctx, &out, node, &node->data, WEIGHT_STRONG);
+ DUMP_FIELD_COPY (&out, node, red);
+ DUMP_FIELD_COPY (&out, node, rear_advance);
+ DUMP_FIELD_COPY (&out, node, front_advance);
+ dump_off offset = dump_object_finish (ctx, &out, sizeof (out));
+ if (node->parent)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct itree_node, parent),
+ dump_interval_node (ctx, node->parent, offset));
+ if (node->left)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct itree_node, left),
+ dump_interval_node (ctx, node->left, offset));
+ if (node->right)
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct itree_node, right),
+ dump_interval_node (ctx, node->right, offset));
+ return offset;
+}
+
static dump_off
dump_overlay (struct dump_context *ctx, const struct Lisp_Overlay *overlay)
{
-#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_72EADA9882)
+#if CHECK_STRUCTS && !defined (HASH_Lisp_Overlay_EB4C05D8D2)
# error "Lisp_Overlay changed. See CHECK_STRUCTS comment in config.h."
#endif
START_DUMP_PVEC (ctx, &overlay->header, struct Lisp_Overlay, out);
dump_pseudovector_lisp_fields (ctx, &out->header, &overlay->header);
- dump_field_lv_rawptr (ctx, out, overlay, &overlay->next,
- Lisp_Vectorlike, WEIGHT_STRONG);
- return finish_dump_pvec (ctx, &out->header);
+ dump_field_fixup_later (ctx, &out, overlay, &overlay->interval);
+ dump_off offset = finish_dump_pvec (ctx, &out->header);
+ dump_remember_fixup_ptr_raw
+ (ctx,
+ offset + dump_offsetof (struct Lisp_Overlay, interval),
+ dump_interval_node (ctx, overlay->interval, offset));
+ return offset;
}
static void
@@ -2701,7 +2748,7 @@ dump_hash_table (struct dump_context *ctx,
static dump_off
dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
{
-#if CHECK_STRUCTS && !defined HASH_buffer_AA373AEE10
+#if CHECK_STRUCTS && !defined HASH_buffer_193CAA5E45
# error "buffer changed. See CHECK_STRUCTS comment in config.h."
#endif
struct buffer munged_buffer = *in_buffer;
@@ -2816,13 +2863,12 @@ dump_buffer (struct dump_context *ctx, const struct
buffer *in_buffer)
DUMP_FIELD_COPY (out, buffer, inhibit_buffer_hooks);
DUMP_FIELD_COPY (out, buffer, long_line_optimizations_p);
- dump_field_lv_rawptr (ctx, out, buffer, &buffer->overlays_before,
- Lisp_Vectorlike, WEIGHT_NORMAL);
-
- dump_field_lv_rawptr (ctx, out, buffer, &buffer->overlays_after,
- Lisp_Vectorlike, WEIGHT_NORMAL);
+ if (buffer->overlays && buffer->overlays->root != NULL)
+ /* We haven't implemented the code to dump overlays. */
+ emacs_abort ();
+ else
+ out->overlays = NULL;
- DUMP_FIELD_COPY (out, buffer, overlay_center);
dump_field_lv (ctx, out, buffer, &buffer->undo_list_,
WEIGHT_STRONG);
dump_off offset = finish_dump_pvec (ctx, &out->header);
diff --git a/src/pgtkfns.c b/src/pgtkfns.c
index 9473e14f5c..a32067af81 100644
--- a/src/pgtkfns.c
+++ b/src/pgtkfns.c
@@ -473,10 +473,19 @@ pgtk_set_tab_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
pgtk_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
@@ -1112,13 +1121,6 @@ pgtk_default_font_parameter (struct frame *f,
Lisp_Object parms)
if (NILP (font))
error ("No suitable font was found");
}
- else if (!NILP (font_param))
- {
- /* Remember the explicit font parameter, so we can re-apply it after
- we've applied the `default' face settings. */
- AUTO_FRAME_ARG (arg, Qfont_parameter, font_param);
- gui_set_frame_parameters (f, arg);
- }
/* This call will make X resources override any system font setting. */
gui_default_parameter (f, parms, Qfont, font, "font", "Font",
diff --git a/src/pgtkterm.c b/src/pgtkterm.c
index 491ba33882..13f6c6c3c4 100644
--- a/src/pgtkterm.c
+++ b/src/pgtkterm.c
@@ -511,16 +511,16 @@ pgtk_free_frame_resources (struct frame *f)
if (FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider != NULL)
{
- GtkCssProvider *old =
- FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider;
+ GtkCssProvider *old
+ = FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider;
g_object_unref (old);
FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider = NULL;
}
if (FRAME_X_OUTPUT (f)->scrollbar_background_css_provider != NULL)
{
- GtkCssProvider *old =
- FRAME_X_OUTPUT (f)->scrollbar_background_css_provider;
+ GtkCssProvider *old
+ = FRAME_X_OUTPUT (f)->scrollbar_background_css_provider;
g_object_unref (old);
FRAME_X_OUTPUT (f)->scrollbar_background_css_provider = NULL;
}
@@ -714,40 +714,42 @@ pgtk_set_window_size (struct frame *f, bool
change_gravity,
void
pgtk_iconify_frame (struct frame *f)
-/* --------------------------------------------------------------------------
- External: Iconify window
- --------------------------------------------------------------------------
*/
{
+ GtkWindow *window;
+
/* Don't keep the highlight on an invisible frame. */
+
if (FRAME_DISPLAY_INFO (f)->highlight_frame == f)
- FRAME_DISPLAY_INFO (f)->highlight_frame = 0;
+ FRAME_DISPLAY_INFO (f)->highlight_frame = NULL;
+
+ /* If the frame is already iconified, return. */
if (FRAME_ICONIFIED_P (f))
return;
- block_input ();
+ /* Child frames on PGTK have no outer widgets. In that case, simply
+ refuse to iconify the frame. */
if (FRAME_GTK_OUTER_WIDGET (f))
{
if (!FRAME_VISIBLE_P (f))
gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (f));
- gtk_window_iconify (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)));
- SET_FRAME_VISIBLE (f, 0);
- SET_FRAME_ICONIFIED (f, true);
- unblock_input ();
- return;
- }
+ window = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f));
- /* Make sure the X server knows where the window should be positioned,
- in case the user deiconifies with the window manager. */
- if (!FRAME_VISIBLE_P (f) && !FRAME_ICONIFIED_P (f))
- pgtk_set_offset (f, f->left_pos, f->top_pos, 0);
+ gtk_window_iconify (window);
- SET_FRAME_ICONIFIED (f, true);
- SET_FRAME_VISIBLE (f, 0);
+ /* Don't make the frame iconified here. Doing so will cause it
+ to be skipped by redisplay, until GDK says it is deiconified
+ (see window_state_event for more details). However, if the
+ window server rejects the iconification request, GDK will
+ never tell Emacs about the iconification not happening,
+ leading to the frame not being redisplayed until the next
+ window state change. */
- unblock_input ();
+ /* SET_FRAME_VISIBLE (f, 0);
+ SET_FRAME_ICONIFIED (f, true); */
+ }
}
static gboolean
@@ -1331,8 +1333,8 @@ fill_background_by_face (struct frame *f, struct face
*face, int x, int y,
if (face->stipple != 0)
{
- cairo_pattern_t *mask =
- FRAME_DISPLAY_INFO (f)->bitmaps[face->stipple - 1].pattern;
+ cairo_pattern_t *mask
+ = FRAME_DISPLAY_INFO (f)->bitmaps[face->stipple - 1].pattern;
double r = ((face->foreground >> 16) & 0xff) / 255.0;
double g = ((face->foreground >> 8) & 0xff) / 255.0;
@@ -1604,8 +1606,8 @@ pgtk_draw_glyphless_glyph_string_foreground (struct
glyph_string *s)
/* It is assured that all LEN characters in STR is ASCII. */
for (j = 0; j < len; j++)
- char2b[j] =
- s->font->driver->encode_char (s->font, str[j]) & 0xFFFF;
+ char2b[j]
+ = s->font->driver->encode_char (s->font, str[j]) & 0xFFFF;
s->font->driver->draw (s, 0, upper_len,
x + glyph->slice.glyphless.upper_xoff,
s->ybase + glyph->slice.glyphless.upper_yoff,
@@ -2956,8 +2958,8 @@ pgtk_draw_window_cursor (struct window *w, struct
glyph_row *glyph_row, int x,
if (w == XWINDOW (f->selected_window))
{
- int frame_x =
- WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w);
+ int frame_x = (WINDOW_TO_FRAME_PIXEL_X (w, x)
+ + WINDOW_LEFT_FRINGE_WIDTH (w));
int frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, y);
pgtk_im_set_cursor_location (f, frame_x, frame_y,
w->phys_cursor_width,
@@ -4516,16 +4518,29 @@ pgtk_free_pixmap (struct frame *f, Emacs_Pixmap pixmap)
void
pgtk_focus_frame (struct frame *f, bool noactivate)
{
- struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f);
+ struct pgtk_display_info *dpyinfo;
+ GtkWidget *widget;
+ GtkWindow *window;
- GtkWidget *wid = FRAME_WIDGET (f);
+ dpyinfo = FRAME_DISPLAY_INFO (f);
- if (dpyinfo->x_focus_frame != f && wid != NULL)
+ if (FRAME_GTK_OUTER_WIDGET (f) && !noactivate)
{
- block_input ();
- gtk_widget_grab_focus (wid);
- unblock_input ();
+ /* The user says it is okay to activate the frame. Call
+ gtk_window_present_with_time. If the timestamp specified
+ (actually a display serial on Wayland) is new enough, then
+ any Wayland compositor supporting gtk_surface1_present will
+ cause the frame to be activated. */
+
+ window = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f));
+ gtk_window_present_with_time (window, dpyinfo->last_user_time);
+ return;
}
+
+ widget = FRAME_WIDGET (f);
+
+ if (widget)
+ gtk_widget_grab_focus (widget);
}
static void
@@ -5142,13 +5157,15 @@ static gboolean
key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data)
{
union buffered_input_event inev;
- ptrdiff_t nbytes = 0;
+ ptrdiff_t nbytes;
Mouse_HLInfo *hlinfo;
struct frame *f;
+ struct pgtk_display_info *dpyinfo;
f = pgtk_any_window_to_frame (gtk_widget_get_window (widget));
EVENT_INIT (inev.ie);
hlinfo = MOUSE_HL_INFO (f);
+ nbytes = 0;
/* If mouse-highlight is an integer, input clears out
mouse highlighting. */
@@ -5179,6 +5196,12 @@ key_press_event (GtkWidget *widget, GdkEvent *event,
gpointer *user_data)
Lisp_Object c;
guint state;
+ dpyinfo = FRAME_DISPLAY_INFO (f);
+
+ /* Set the last user time for pgtk_focus_frame to work
+ correctly. */
+ dpyinfo->last_user_time = event->key.time;
+
state = event->key.state;
/* While super is pressed, the input method will always always
@@ -5212,8 +5235,8 @@ key_press_event (GtkWidget *widget, GdkEvent *event,
gpointer *user_data)
/* Common for all keysym input events. */
XSETFRAME (inev.ie.frame_or_window, f);
- inev.ie.modifiers =
- pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers);
+ inev.ie.modifiers
+ = pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers);
inev.ie.timestamp = event->key.time;
/* First deal with keysyms which have defined
@@ -5361,11 +5384,37 @@ done:
return TRUE;
}
+static struct pgtk_display_info *
+pgtk_display_info_for_display (GdkDisplay *dpy)
+{
+ struct pgtk_display_info *dpyinfo;
+
+ for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next)
+ {
+ if (dpyinfo->display == dpy)
+ return dpyinfo;
+ }
+
+ return NULL;
+}
+
static gboolean
key_release_event (GtkWidget *widget,
GdkEvent *event,
gpointer *user_data)
{
+ GdkDisplay *display;
+ struct pgtk_display_info *dpyinfo;
+
+ display = gtk_widget_get_display (widget);
+ dpyinfo = pgtk_display_info_for_display (display);
+
+ if (dpyinfo)
+ /* This is needed on Wayland because of some brain dead
+ compositors. Without them, we would not have to keep track of
+ the serial of key release events. */
+ dpyinfo->last_user_time = event->key.time;
+
return TRUE;
}
@@ -5420,9 +5469,7 @@ map_event (GtkWidget *widget,
/* Check if fullscreen was specified before we where mapped the
first time, i.e. from the command line. */
if (!FRAME_X_OUTPUT (f)->has_been_visible)
- {
- set_fullscreen_state (f);
- }
+ set_fullscreen_state (f);
if (!iconified)
{
@@ -5465,24 +5512,6 @@ window_state_event (GtkWidget *widget,
inev.ie.kind = NO_EVENT;
inev.ie.arg = Qnil;
- if (f)
- {
- if (new_state & GDK_WINDOW_STATE_FOCUSED)
- {
- if (FRAME_ICONIFIED_P (f))
- {
- /* Gnome shell does not iconify us when C-z is pressed.
- It hides the frame. So if our state says we aren't
- hidden anymore, treat it as deiconified. */
- SET_FRAME_VISIBLE (f, 1);
- SET_FRAME_ICONIFIED (f, false);
- FRAME_X_OUTPUT (f)->has_been_visible = true;
- inev.ie.kind = DEICONIFY_EVENT;
- XSETFRAME (inev.ie.frame_or_window, f);
- }
- }
- }
-
if (new_state & GDK_WINDOW_STATE_FULLSCREEN)
store_frame_param (f, Qfullscreen, Qfullboth);
else if (new_state & GDK_WINDOW_STATE_MAXIMIZED)
@@ -5500,14 +5529,37 @@ window_state_event (GtkWidget *widget,
else
store_frame_param (f, Qfullscreen, Qnil);
+ /* The Wayland protocol provides no way for the client to know
+ whether or not one of its toplevels has actually been
+ deiconified. It only provides a request for clients to iconify a
+ toplevel, without even the ability to determine whether or not
+ the iconification request was rejected by the display server.
+
+ GDK computes the iconified state by sending a window state event
+ containing only GDK_WINDOW_STATE_ICONIFIED immediately after
+ gtk_window_iconify is called. That is error-prone if the request
+ to iconify the frame was rejected by the display server, but is
+ not the main problem here, as Wayland compositors only rarely
+ reject such requests. GDK also assumes that it can clear the
+ iconified state upon receiving the next toplevel configure event
+ from the display server. Unfortunately, such events can be sent
+ by Wayland compositors while the frame is iconified, and may also
+ not be sent upon deiconification. So, no matter what Emacs does,
+ the iconification state of a frame is likely to be wrong under
+ one situation or another. */
+
if (new_state & GDK_WINDOW_STATE_ICONIFIED)
- SET_FRAME_ICONIFIED (f, true);
+ {
+ SET_FRAME_ICONIFIED (f, true);
+ SET_FRAME_VISIBLE (f, false);
+ }
else
{
FRAME_X_OUTPUT (f)->has_been_visible = true;
inev.ie.kind = DEICONIFY_EVENT;
XSETFRAME (inev.ie.frame_or_window, f);
SET_FRAME_ICONIFIED (f, false);
+ SET_FRAME_VISIBLE (f, true);
}
if (new_state & GDK_WINDOW_STATE_STICKY)
@@ -5899,9 +5951,10 @@ construct_mouse_click (struct input_event *result,
result->kind = MOUSE_CLICK_EVENT;
result->code = event->button - 1;
result->timestamp = event->time;
- result->modifiers =
- (pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), event->state) |
- (event->type == GDK_BUTTON_RELEASE ? up_modifier : down_modifier));
+ result->modifiers = (pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f),
+ event->state)
+ | (event->type == GDK_BUTTON_RELEASE
+ ? up_modifier : down_modifier));
XSETINT (result->x, event->x);
XSETINT (result->y, event->y);
@@ -5966,6 +6019,10 @@ button_event (GtkWidget *widget, GdkEvent *event,
}
}
+ /* Set the last user time, used to activate the frame in
+ pgtk_focus_frame. */
+ dpyinfo->last_user_time = event->button.time;
+
if (f)
{
/* Is this in the tab-bar? */
@@ -5984,10 +6041,7 @@ button_event (GtkWidget *widget, GdkEvent *event,
(f, x, y, event->type == GDK_BUTTON_PRESS,
pgtk_gtk_to_emacs_modifiers (dpyinfo, event->button.state));
}
- }
- if (f)
- {
if (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p)
{
if (ignore_next_mouse_click_timeout)
@@ -6055,8 +6109,8 @@ scroll_event (GtkWidget *widget, GdkEvent *event,
gpointer *user_data)
inev.ie.kind = NO_EVENT;
inev.ie.timestamp = event->scroll.time;
- inev.ie.modifiers =
- pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), event->scroll.state);
+ inev.ie.modifiers
+ = pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f),
event->scroll.state);
XSETINT (inev.ie.x, event->scroll.x);
XSETINT (inev.ie.y, event->scroll.y);
XSETFRAME (inev.ie.frame_or_window, f);
@@ -6594,6 +6648,44 @@ pgtk_selection_event (GtkWidget *widget, GdkEvent *event,
return FALSE;
}
+/* Display a warning message if the PGTK port is being used under X;
+ that is not supported. */
+
+static void
+pgtk_display_x_warning (GdkDisplay *display)
+{
+ GtkWidget *dialog_widget, *label, *content_area;
+ GtkDialog *dialog;
+ GtkWindow *window;
+ GdkScreen *screen;
+
+ /* Do this instead of GDK_IS_X11_DISPLAY because the GDK X header
+ pulls in Xlib, which conflicts with definitions in pgtkgui.h. */
+ if (strcmp (G_OBJECT_TYPE_NAME (display),
+ "GdkX11Display"))
+ return;
+
+ dialog_widget = gtk_dialog_new ();
+ dialog = GTK_DIALOG (dialog_widget);
+ window = GTK_WINDOW (dialog_widget);
+ screen = gdk_display_get_default_screen (display);
+ content_area = gtk_dialog_get_content_area (dialog);
+
+ gtk_window_set_title (window, "Warning");
+ gtk_window_set_screen (window, screen);
+
+ label = gtk_label_new ("You are trying to run Emacs configured with"
+ " the \"pure-GTK\" interface under the X Window"
+ " System. That configuration is unsupported and"
+ " will lead to sporadic crashes during transfer of"
+ " large selection data. It will also lead to"
+ " various problems with keyboard input.");
+ gtk_label_set_line_wrap (GTK_LABEL (label), TRUE);
+ gtk_container_add (GTK_CONTAINER (content_area), label);
+ gtk_widget_show (label);
+ gtk_widget_show (dialog_widget);
+}
+
/* Open a connection to X display DISPLAY_NAME, and return
the structure that describes the open display.
If we cannot contact the display, return null. */
@@ -6697,6 +6789,9 @@ pgtk_term_init (Lisp_Object display_name, char
*resource_name)
return 0;
}
+ /* If the PGTK port is being used under X, complain very loudly, as
+ that isn't supported. */
+ pgtk_display_x_warning (dpy);
dpyinfo = xzalloc (sizeof *dpyinfo);
pgtk_initialize_display_info (dpyinfo);
@@ -6940,10 +7035,9 @@ pgtk_parse_color (struct frame *f, const char
*color_name,
color->red = rgba.red * 65535;
color->green = rgba.green * 65535;
color->blue = rgba.blue * 65535;
- color->pixel =
- (color->red >> 8) << 16 |
- (color->green >> 8) << 8 |
- (color->blue >> 8) << 0;
+ color->pixel = ((color->red >> 8) << 16
+ | (color->green >> 8) << 8
+ | (color->blue >> 8) << 0);
return 1;
}
return 0;
@@ -7072,10 +7166,9 @@ If set to a non-float value, there will be no wait at
all. */);
Vpgtk_wait_for_event_timeout = make_float (0.1);
DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table,
- doc: /* Hash table of character codes indexed by X keysym codes.
*/);
- Vpgtk_keysym_table =
- make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE,
- DEFAULT_REHASH_THRESHOLD, Qnil, false);
+ doc: /* Hash table of character codes indexed by X keysym codes. */);
+ Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE,
+ DEFAULT_REHASH_THRESHOLD, Qnil, false);
window_being_scrolled = Qnil;
staticpro (&window_being_scrolled);
@@ -7113,13 +7206,13 @@ pgtk_begin_cr_clip (struct frame *f)
if (!cr)
{
- cairo_surface_t *surface =
- gdk_window_create_similar_surface (gtk_widget_get_window
- (FRAME_GTK_WIDGET (f)),
- CAIRO_CONTENT_COLOR_ALPHA,
- FRAME_CR_SURFACE_DESIRED_WIDTH (f),
- FRAME_CR_SURFACE_DESIRED_HEIGHT
- (f));
+ cairo_surface_t *surface
+ = gdk_window_create_similar_surface (gtk_widget_get_window
+ (FRAME_GTK_WIDGET (f)),
+ CAIRO_CONTENT_COLOR_ALPHA,
+ FRAME_CR_SURFACE_DESIRED_WIDTH (f),
+ FRAME_CR_SURFACE_DESIRED_HEIGHT
+ (f));
cr = FRAME_CR_CONTEXT (f) = cairo_create (surface);
cairo_surface_destroy (surface);
diff --git a/src/pgtkterm.h b/src/pgtkterm.h
index fcc6c5310e..b6bd10dcb4 100644
--- a/src/pgtkterm.h
+++ b/src/pgtkterm.h
@@ -262,6 +262,13 @@ struct pgtk_output
unsigned long background_color;
void *toolbar;
+ /* The "time" of the last user interaction on this display. Set
+ upon button and key press and release events.
+
+ Under the GDK Wayland backend, this is actually an event
+ serial. */
+ guint32 last_user_time;
+
/* Cursors */
Emacs_Cursor current_cursor;
Emacs_Cursor text_cursor;
@@ -357,8 +364,8 @@ struct pgtk_output
/* The tool bar in this frame */
GtkWidget *toolbar_widget;
/* True if tool bar is packed into the hbox widget (i.e. vertical). */
- bool_bf toolbar_in_hbox:1;
- bool_bf toolbar_is_packed:1;
+ bool_bf toolbar_in_hbox : 1;
+ bool_bf toolbar_is_packed : 1;
GtkTooltip *ttip_widget;
GtkWidget *ttip_lbl;
diff --git a/src/print.c b/src/print.c
index 1749d79299..d8f87c6303 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1,7 +1,6 @@
/* Lisp object printing and output streams.
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2022 Free Software
-Foundation, Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -598,8 +597,7 @@ temp_output_buffer_setup (const char *bufname)
bset_read_only (current_buffer, Qnil);
bset_filename (current_buffer, Qnil);
bset_undo_list (current_buffer, Qt);
- eassert (current_buffer->overlays_before == NULL);
- eassert (current_buffer->overlays_after == NULL);
+ eassert (current_buffer->overlays == NULL);
bset_enable_multibyte_characters
(current_buffer, BVAR (&buffer_defaults, enable_multibyte_characters));
specbind (Qinhibit_read_only, Qt);
@@ -1749,15 +1747,15 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
case PVEC_OVERLAY:
print_c_string ("#<overlay ", printcharfun);
- if (! XMARKER (OVERLAY_START (obj))->buffer)
+ if (! OVERLAY_BUFFER (obj))
print_c_string ("in no buffer", printcharfun);
else
{
int len = sprintf (buf, "from %"pD"d to %"pD"d in ",
- marker_position (OVERLAY_START (obj)),
- marker_position (OVERLAY_END (obj)));
+ OVERLAY_START (obj),
+ OVERLAY_END (obj));
strout (buf, len, len, printcharfun);
- print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name),
+ print_string (BVAR (OVERLAY_BUFFER (obj), name),
printcharfun);
}
printchar ('>', printcharfun);
@@ -2062,8 +2060,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
i = sprintf (buf, " stmt=%p", XSQLITE (obj)->stmt);
strout (buf, i, i, printcharfun);
}
- i = sprintf (buf, " name=%s", XSQLITE (obj)->name);
- strout (buf, i, i, printcharfun);
+ print_c_string (" name=", printcharfun);
+ print_c_string (XSQLITE (obj)->name, printcharfun);
printchar ('>', printcharfun);
}
break;
diff --git a/src/process.c b/src/process.c
index 358899cded..5144c5d6c9 100644
--- a/src/process.c
+++ b/src/process.c
@@ -292,7 +292,6 @@ static int child_signal_read_fd = -1;
descriptor to notify `wait_reading_process_output' of process
status changes. */
static int child_signal_write_fd = -1;
-static void child_signal_init (void);
#ifndef WINDOWSNT
static void child_signal_read (int, void *);
#endif
@@ -7323,7 +7322,7 @@ process has been transmitted to the serial port. */)
/* Set up `child_signal_read_fd' and `child_signal_write_fd'. */
-static void
+void
child_signal_init (void)
{
/* Either both are initialized, or both are uninitialized. */
diff --git a/src/regex-emacs.c b/src/regex-emacs.c
index 9b2c14c413..626560911f 100644
--- a/src/regex-emacs.c
+++ b/src/regex-emacs.c
@@ -3446,14 +3446,18 @@ static bool bcmp_translate (re_char *, re_char *,
ptrdiff_t,
/* Call before fetching a character with *d. This switches over to
string2 if necessary.
+ `reset' is executed before backtracking if there are no more characters.
Check re_match_2_internal for a discussion of why end_match_2 might
not be within string2 (but be equal to end_match_1 instead). */
-#define PREFETCH() \
+#define PREFETCH(reset)
\
while (d == dend) \
{ \
/* End of string2 => fail. */ \
if (dend == end_match_2) \
- goto fail; \
+ { \
+ reset; \
+ goto fail; \
+ } \
/* End of string1 => advance to string2. */ \
d = string2; \
dend = end_match_2; \
@@ -4252,7 +4256,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
int pat_charlen, buf_charlen;
int pat_ch, buf_ch;
- PREFETCH ();
+ PREFETCH (d = dfail);
if (multibyte)
pat_ch = string_char_and_length (p, &pat_charlen);
else
@@ -4280,7 +4284,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
int pat_charlen;
int pat_ch, buf_ch;
- PREFETCH ();
+ PREFETCH (d = dfail);
if (multibyte)
{
pat_ch = string_char_and_length (p, &pat_charlen);
@@ -4486,7 +4490,7 @@ re_match_2_internal (struct re_pattern_buffer *bufp,
if (d2 == dend2) break;
/* If necessary, advance to next segment in data. */
- PREFETCH ();
+ PREFETCH (d = dfail);
/* How many characters left in this segment to match. */
dcnt = dend - d;
diff --git a/src/search.c b/src/search.c
index bd1adbbe09..242681bbba 100644
--- a/src/search.c
+++ b/src/search.c
@@ -1566,7 +1566,6 @@ simple_search (EMACS_INT n, unsigned char *pat,
while (1)
{
/* Try matching at position POS. */
- ptrdiff_t this_pos = pos;
ptrdiff_t this_pos_byte = pos_byte;
ptrdiff_t this_len = len;
unsigned char *p = pat;
@@ -1588,7 +1587,6 @@ simple_search (EMACS_INT n, unsigned char *pat,
p += charlen;
this_pos_byte += buf_charlen;
- this_pos++;
}
if (this_len == 0)
@@ -2832,11 +2830,21 @@ Return value is undefined if the last search failed.
*/)
}
DEFUN ("match-data", Fmatch_data, Smatch_data, 0, 3, 0,
- doc: /* Return a list describing what the last search matched.
-Element 2N is `(match-beginning N)'; element 2N + 1 is `(match-end N)'.
-All the elements are markers or nil (nil if the Nth pair didn't match)
-if the last match was on a buffer; integers or nil if a string was matched.
-Use `set-match-data' to reinstate the data in this list.
+ doc: /* Return a list of positions that record text matched by the last
search.
+Element 2N of the returned list is the position of the beginning of the
+match of the Nth subexpression; it corresponds to `(match-beginning N)';
+element 2N + 1 is the position of the end of the match of the Nth
+subexpression; it corresponds to `(match-end N)'. See `match-beginning'
+and `match-end'.
+If the last search was on a buffer, all the elements are by default
+markers or nil (nil when the Nth pair didn't match); they are integers
+or nil if the search was on a string. But if the optional argument
+INTEGERS is non-nil, the elements that represent buffer positions are
+always integers, not markers, and (if the search was on a buffer) the
+buffer itself is appended to the list as one additional element.
+
+Use `set-match-data' to reinstate the match data from the elements of
+this list.
Note that non-matching optional groups at the end of the regexp are
elided instead of being represented with two `nil's each. For instance:
@@ -2846,16 +2854,13 @@ elided instead of being represented with two `nil's
each. For instance:
(match-data))
=> (0 1 nil nil 0 1)
-If INTEGERS (the optional first argument) is non-nil, always use
-integers (rather than markers) to represent buffer positions. In
-this case, and if the last match was in a buffer, the buffer will get
-stored as one additional element at the end of the list.
-
-If REUSE is a list, reuse it as part of the value. If REUSE is long
-enough to hold all the values, and if INTEGERS is non-nil, no consing
-is done.
+If REUSE is a list, store the value in REUSE by destructively modifying it.
+If REUSE is long enough to hold all the values, its length remains the
+same, and any unused elements are set to nil. If REUSE is not long
+enough, it is extended. Note that if REUSE is long enough and INTEGERS
+is non-nil, no consing is done to make the return value; this minimizes GC.
-If optional third arg RESEAT is non-nil, any previous markers on the
+If optional third argument RESEAT is non-nil, any previous markers on the
REUSE list will be modified to point to nowhere.
Return value is undefined if the last search failed. */)
diff --git a/src/sqlite.c b/src/sqlite.c
index 54bfb7b6c6..ac860f55bc 100644
--- a/src/sqlite.c
+++ b/src/sqlite.c
@@ -50,7 +50,11 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int64,
DEF_DLL_FN (SQLITE_API int, sqlite3_bind_double, (sqlite3_stmt*, int, double));
DEF_DLL_FN (SQLITE_API int, sqlite3_bind_null, (sqlite3_stmt*, int));
DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int, (sqlite3_stmt*, int, int));
+DEF_DLL_FN (SQLITE_API int, sqlite3_extended_errcode, (sqlite3*));
DEF_DLL_FN (SQLITE_API const char*, sqlite3_errmsg, (sqlite3*));
+#if SQLITE_VERSION_NUMBER >= 3007015
+DEF_DLL_FN (SQLITE_API const char*, sqlite3_errstr, (int));
+#endif
DEF_DLL_FN (SQLITE_API int, sqlite3_step, (sqlite3_stmt*));
DEF_DLL_FN (SQLITE_API int, sqlite3_changes, (sqlite3*));
DEF_DLL_FN (SQLITE_API int, sqlite3_column_count, (sqlite3_stmt*));
@@ -87,7 +91,11 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
# undef sqlite3_bind_double
# undef sqlite3_bind_null
# undef sqlite3_bind_int
+# undef sqlite3_extended_errcode
# undef sqlite3_errmsg
+# if SQLITE_VERSION_NUMBER >= 3007015
+# undef sqlite3_errstr
+# endif
# undef sqlite3_step
# undef sqlite3_changes
# undef sqlite3_column_count
@@ -111,7 +119,11 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension,
# define sqlite3_bind_double fn_sqlite3_bind_double
# define sqlite3_bind_null fn_sqlite3_bind_null
# define sqlite3_bind_int fn_sqlite3_bind_int
+# define sqlite3_extended_errcode fn_sqlite3_extended_errcode
# define sqlite3_errmsg fn_sqlite3_errmsg
+# if SQLITE_VERSION_NUMBER >= 3007015
+# define sqlite3_errstr fn_sqlite3_errstr
+# endif
# define sqlite3_step fn_sqlite3_step
# define sqlite3_changes fn_sqlite3_changes
# define sqlite3_column_count fn_sqlite3_column_count
@@ -138,7 +150,11 @@ load_dll_functions (HMODULE library)
LOAD_DLL_FN (library, sqlite3_bind_double);
LOAD_DLL_FN (library, sqlite3_bind_null);
LOAD_DLL_FN (library, sqlite3_bind_int);
+ LOAD_DLL_FN (library, sqlite3_extended_errcode);
LOAD_DLL_FN (library, sqlite3_errmsg);
+#if SQLITE_VERSION_NUMBER >= 3007015
+ LOAD_DLL_FN (library, sqlite3_errstr);
+#endif
LOAD_DLL_FN (library, sqlite3_step);
LOAD_DLL_FN (library, sqlite3_changes);
LOAD_DLL_FN (library, sqlite3_column_count);
@@ -229,13 +245,13 @@ check_sqlite (Lisp_Object db, bool is_statement)
init_sqlite_functions ();
CHECK_SQLITE (db);
if (is_statement && !XSQLITE (db)->is_statement)
- xsignal1 (Qerror, build_string ("Invalid set object"));
+ xsignal1 (Qsqlite_error, build_string ("Invalid set object"));
else if (!is_statement && XSQLITE (db)->is_statement)
- xsignal1 (Qerror, build_string ("Invalid database object"));
+ xsignal1 (Qsqlite_error, build_string ("Invalid database object"));
if (!is_statement && !XSQLITE (db)->db)
- xsignal1 (Qerror, build_string ("Database closed"));
+ xsignal1 (Qsqlite_error, build_string ("Database closed"));
else if (is_statement && !XSQLITE (db)->db)
- xsignal1 (Qerror, build_string ("Statement closed"));
+ xsignal1 (Qsqlite_error, build_string ("Statement closed"));
}
static int db_count = 0;
@@ -255,7 +271,7 @@ If FILE is nil, an in-memory database will be opened
instead. */)
#endif
if (!init_sqlite_functions ())
- xsignal1 (Qerror, build_string ("sqlite support is not available"));
+ xsignal1 (Qsqlite_error, build_string ("sqlite support is not available"));
if (!NILP (file))
name = ENCODE_FILE (Fexpand_file_name (file, Qnil));
@@ -268,7 +284,7 @@ If FILE is nil, an in-memory database will be opened
instead. */)
name = CALLN (Fformat, memory_fmt, make_int (++db_count));
flags |= SQLITE_OPEN_MEMORY;
#else
- xsignal1 (Qerror, build_string ("sqlite in-memory is not available"));
+ xsignal1 (Qsqlite_error, build_string ("sqlite in-memory is not
available"));
#endif
}
@@ -338,7 +354,7 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object
values)
if (blob)
{
if (SBYTES (value) != SCHARS (value))
- xsignal1 (Qerror, build_string ("BLOB values must be unibyte"));
+ xsignal1 (Qsqlite_error, build_string ("BLOB values must be
unibyte"));
ret = sqlite3_bind_blob (stmt, i + 1,
SSDATA (value), SBYTES (value),
NULL);
@@ -373,72 +389,6 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object
values)
return NULL;
}
-DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0,
- doc: /* Execute a non-select SQL statement.
-If VALUES is non-nil, it should be a vector or a list of values
-to bind when executing a statement like
-
- insert into foo values (?, ?, ...)
-
-Value is the number of affected rows. */)
- (Lisp_Object db, Lisp_Object query, Lisp_Object values)
-{
- check_sqlite (db, false);
- CHECK_STRING (query);
- if (!(NILP (values) || CONSP (values) || VECTORP (values)))
- xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
-
- sqlite3 *sdb = XSQLITE (db)->db;
- Lisp_Object retval = Qnil;
- const char *errmsg = NULL;
- Lisp_Object encoded = encode_string (query);
- sqlite3_stmt *stmt = NULL;
-
- /* We only execute the first statement -- if there's several
- (separated by a semicolon), the subsequent statements won't be
- done. */
- int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), -1, &stmt, NULL);
- if (ret != SQLITE_OK)
- {
- if (stmt != NULL)
- {
- sqlite3_finalize (stmt);
- sqlite3_reset (stmt);
- }
-
- errmsg = sqlite3_errmsg (sdb);
- goto exit;
- }
-
- /* Bind ? values. */
- if (!NILP (values)) {
- const char *err = bind_values (sdb, stmt, values);
- if (err != NULL)
- {
- errmsg = err;
- goto exit;
- }
- }
-
- ret = sqlite3_step (stmt);
- sqlite3_finalize (stmt);
- if (ret != SQLITE_OK && ret != SQLITE_DONE)
- {
- errmsg = sqlite3_errmsg (sdb);
- goto exit;
- }
-
- retval = make_fixnum (sqlite3_changes (sdb));
-
- exit:
- if (errmsg != NULL)
- xsignal1 (ret == SQLITE_LOCKED || ret == SQLITE_BUSY?
- Qsqlite_locked_error: Qerror,
- build_string (errmsg));
-
- return retval;
-}
-
static Lisp_Object
row_to_value (sqlite3_stmt *stmt)
{
@@ -483,6 +433,107 @@ row_to_value (sqlite3_stmt *stmt)
return Fnreverse (values);
}
+static Lisp_Object
+sqlite_prepare_errdata (int code, sqlite3 *sdb)
+{
+ Lisp_Object errcode = make_fixnum (code);
+ const char *errmsg = sqlite3_errmsg (sdb);
+ Lisp_Object lerrmsg = errmsg ? build_string (errmsg) : Qnil;
+ Lisp_Object errstr, ext_errcode;
+
+#if SQLITE_VERSION_NUMBER >= 3007015
+ errstr = build_string (sqlite3_errstr (code));
+#else
+ /* The internet says this is identical to sqlite3_errstr (code). */
+ errstr = lerrmsg;
+#endif
+
+ /* More details about what went wrong. */
+#if SQLITE_VERSION_NUMBER >= 3006005
+ ext_errcode = make_fixnum (sqlite3_extended_errcode (sdb));
+#else
+ /* What value to use here? */
+ ext_errcode = make_fixnum (0);
+#endif
+
+ return list4 (errstr, lerrmsg, errcode, ext_errcode);
+}
+
+DEFUN ("sqlite-execute", Fsqlite_execute, Ssqlite_execute, 2, 3, 0,
+ doc: /* Execute a non-select SQL statement.
+If VALUES is non-nil, it should be a vector or a list of values
+to bind when executing a statement like
+
+ insert into foo values (?, ?, ...)
+
+Value is the number of affected rows. */)
+ (Lisp_Object db, Lisp_Object query, Lisp_Object values)
+{
+ check_sqlite (db, false);
+ CHECK_STRING (query);
+ if (!(NILP (values) || CONSP (values) || VECTORP (values)))
+ xsignal1 (Qsqlite_error, build_string ("VALUES must be a list or a
vector"));
+
+ sqlite3 *sdb = XSQLITE (db)->db;
+ Lisp_Object errmsg = Qnil,
+ encoded = encode_string (query);
+ sqlite3_stmt *stmt = NULL;
+
+ /* We only execute the first statement -- if there's several
+ (separated by a semicolon), the subsequent statements won't be
+ done. */
+ int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), -1, &stmt, NULL);
+ if (ret != SQLITE_OK)
+ {
+ if (stmt != NULL)
+ {
+ sqlite3_finalize (stmt);
+ sqlite3_reset (stmt);
+ }
+
+ errmsg = sqlite_prepare_errdata (ret, sdb);
+ goto exit;
+ }
+
+ /* Bind ? values. */
+ if (!NILP (values))
+ {
+ const char *err = bind_values (sdb, stmt, values);
+ if (err != NULL)
+ {
+ errmsg = build_string (err);
+ goto exit;
+ }
+ }
+
+ ret = sqlite3_step (stmt);
+
+ if (ret == SQLITE_ROW)
+ {
+ Lisp_Object data = Qnil;
+ do
+ data = Fcons (row_to_value (stmt), data);
+ while (sqlite3_step (stmt) == SQLITE_ROW);
+
+ sqlite3_finalize (stmt);
+ return Fnreverse (data);
+ }
+ else if (ret == SQLITE_OK || ret == SQLITE_DONE)
+ {
+ Lisp_Object rows = make_fixnum (sqlite3_changes (sdb));
+ sqlite3_finalize (stmt);
+ return rows;
+ }
+ else
+ errmsg = build_string (sqlite3_errmsg (sdb));
+
+ exit:
+ sqlite3_finalize (stmt);
+ xsignal1 (ret == SQLITE_LOCKED || ret == SQLITE_BUSY?
+ Qsqlite_locked_error: Qsqlite_error,
+ errmsg);
+}
+
static Lisp_Object
column_names (sqlite3_stmt *stmt)
{
@@ -499,14 +550,15 @@ DEFUN ("sqlite-select", Fsqlite_select, Ssqlite_select,
2, 4, 0,
If VALUES is non-nil, it should be a list or a vector specifying the
values that will be interpolated into a parameterized statement.
-By default, the return value is a list where the first element is a
-list of column names, and the rest of the elements are the matching data.
+By default, the return value is a list, whose contents depend on
+the value of the optional argument RETURN-TYPE.
-RETURN-TYPE can be either nil (which means that the matching data
-should be returned as a list of rows), or `full' (the same, but the
-first element in the return list will be the column names), or `set',
-which means that we return a set object that can be queried with
-`sqlite-next' and other functions to get the data. */)
+If RETURN-TYPE is nil or omitted, the function returns a list of rows
+matching QUERY. If RETURN-TYPE is `full', the function returns a
+list whose first element is the list of column names, and the rest
+of the elements are the rows matching QUERY. If RETURN-TYPE is `set',
+the function returns a set object that can be queried with functions
+like `sqlite-next' etc., in order to get the data. */)
(Lisp_Object db, Lisp_Object query, Lisp_Object values,
Lisp_Object return_type)
{
@@ -514,12 +566,11 @@ which means that we return a set object that can be
queried with
CHECK_STRING (query);
if (!(NILP (values) || CONSP (values) || VECTORP (values)))
- xsignal1 (Qerror, build_string ("VALUES must be a list or a vector"));
+ xsignal1 (Qsqlite_error, build_string ("VALUES must be a list or a
vector"));
sqlite3 *sdb = XSQLITE (db)->db;
- Lisp_Object retval = Qnil;
- const char *errmsg = NULL;
- Lisp_Object encoded = encode_string (query);
+ Lisp_Object retval = Qnil, errmsg = Qnil,
+ encoded = encode_string (query);
sqlite3_stmt *stmt = NULL;
int ret = sqlite3_prepare_v2 (sdb, SSDATA (encoded), SBYTES (encoded),
@@ -528,7 +579,7 @@ which means that we return a set object that can be queried
with
{
if (stmt)
sqlite3_finalize (stmt);
-
+ errmsg = sqlite_prepare_errdata (ret, sdb);
goto exit;
}
@@ -539,7 +590,7 @@ which means that we return a set object that can be queried
with
if (err != NULL)
{
sqlite3_finalize (stmt);
- errmsg = err;
+ errmsg = build_string (err);
goto exit;
}
}
@@ -553,7 +604,7 @@ which means that we return a set object that can be queried
with
/* Return the data directly. */
Lisp_Object data = Qnil;
- while ((ret = sqlite3_step (stmt)) == SQLITE_ROW)
+ while (sqlite3_step (stmt) == SQLITE_ROW)
data = Fcons (row_to_value (stmt), data);
if (EQ (return_type, Qfull))
@@ -563,8 +614,8 @@ which means that we return a set object that can be queried
with
sqlite3_finalize (stmt);
exit:
- if (errmsg != NULL)
- xsignal1 (Qerror, build_string (errmsg));
+ if (! NILP (errmsg))
+ xsignal1 (Qsqlite_error, errmsg);
return retval;
}
@@ -650,7 +701,7 @@ Only modules on Emacs' list of allowed modules can be
loaded. */)
}
if (!do_allow)
- xsignal (Qerror, build_string ("Module name not on allowlist"));
+ xsignal1 (Qsqlite_error, build_string ("Module name not on allowlist"));
int result = sqlite3_load_extension
(XSQLITE (db)->db,
@@ -670,7 +721,7 @@ DEFUN ("sqlite-next", Fsqlite_next, Ssqlite_next, 1, 1, 0,
int ret = sqlite3_step (XSQLITE (set)->stmt);
if (ret != SQLITE_ROW && ret != SQLITE_OK && ret != SQLITE_DONE)
- xsignal1 (Qerror, build_string (sqlite3_errmsg (XSQLITE (set)->db)));
+ xsignal1 (Qsqlite_error, build_string (sqlite3_errmsg (XSQLITE
(set)->db)));
if (ret == SQLITE_DONE)
{
@@ -769,9 +820,15 @@ syms_of_sqlite (void)
defsubr (&Ssqlitep);
defsubr (&Ssqlite_available_p);
+ DEFSYM (Qsqlite_error, "sqlite-error");
+ Fput (Qsqlite_error, Qerror_conditions,
+ Fpurecopy (list2 (Qsqlite_error, Qerror)));
+ Fput (Qsqlite_error, Qerror_message,
+ build_pure_c_string ("Database error"));
+
DEFSYM (Qsqlite_locked_error, "sqlite-locked-error");
Fput (Qsqlite_locked_error, Qerror_conditions,
- Fpurecopy (list2 (Qsqlite_locked_error, Qerror)));
+ Fpurecopy (list3 (Qsqlite_locked_error, Qsqlite_error, Qerror)));
Fput (Qsqlite_locked_error, Qerror_message,
build_pure_c_string ("Database locked"));
diff --git a/src/sysdep.c b/src/sysdep.c
index abb385d138..736723bdf3 100644
--- a/src/sysdep.c
+++ b/src/sysdep.c
@@ -2432,7 +2432,7 @@ emacs_pipe (int fd[2])
/* Approximate posix_close and POSIX_CLOSE_RESTART well enough for Emacs.
For the background behind this mess, please see Austin Group defect 529
- <http://austingroupbugs.net/view.php?id=529>. */
+ <https://austingroupbugs.net/view.php?id=529>. */
#ifndef POSIX_CLOSE_RESTART
# define POSIX_CLOSE_RESTART 1
diff --git a/src/textprop.c b/src/textprop.c
index c91a2b729c..ca693fd680 100644
--- a/src/textprop.c
+++ b/src/textprop.c
@@ -1,6 +1,5 @@
/* Interface code for dealing with text properties.
- Copyright (C) 1993-1995, 1997, 1999-2022 Free Software Foundation,
- Inc.
+ Copyright (C) 1993-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -634,36 +633,40 @@ get_char_property_and_overlay (Lisp_Object position,
register Lisp_Object prop,
}
if (BUFFERP (object))
{
- ptrdiff_t noverlays;
- Lisp_Object *overlay_vec;
- struct buffer *obuf = current_buffer;
-
- if (! (BUF_BEGV (XBUFFER (object)) <= pos
- && pos <= BUF_ZV (XBUFFER (object))))
+ struct buffer *b = XBUFFER (object);
+ struct itree_node *node;
+ struct sortvec items[2];
+ struct sortvec *result = NULL;
+ Lisp_Object result_tem = Qnil;
+
+ if (! (BUF_BEGV (b) <= pos
+ && pos <= BUF_ZV (b)))
xsignal1 (Qargs_out_of_range, position);
- set_buffer_temp (XBUFFER (object));
-
- USE_SAFE_ALLOCA;
- GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false);
- noverlays = sort_overlays (overlay_vec, noverlays, w);
-
- set_buffer_temp (obuf);
-
/* Now check the overlays in order of decreasing priority. */
- while (--noverlays >= 0)
+ ITREE_FOREACH (node, b->overlays, pos, pos + 1, ASCENDING)
{
- Lisp_Object tem = Foverlay_get (overlay_vec[noverlays], prop);
- if (!NILP (tem))
- {
- if (overlay)
- /* Return the overlay we got the property from. */
- *overlay = overlay_vec[noverlays];
- SAFE_FREE ();
- return tem;
- }
+ Lisp_Object tem = Foverlay_get (node->data, prop);
+ struct sortvec *this;
+
+ if (NILP (tem) || node->end < pos + 1
+ || (w && ! overlay_matches_window (w, node->data)))
+ continue;
+
+ this = (result == items ? items + 1 : items);
+ make_sortvec_item (this, node->data);
+ if (! result || (compare_overlays (result, this) < 0))
+ {
+ result = this;
+ result_tem = tem;
+ }
}
- SAFE_FREE ();
+ if (result)
+ {
+ if (overlay)
+ *overlay = result->overlay;
+ return result_tem;
+ }
}
if (overlay)
@@ -2389,15 +2392,7 @@ returned. */);
DEFVAR_LISP ("inhibit-point-motion-hooks", Vinhibit_point_motion_hooks,
doc: /* If non-nil, don't run `point-left' and `point-entered'
text properties.
-This also inhibits the use of the `intangible' text property.
-
-This variable is obsolete since Emacs-25.1. Use `cursor-intangible-mode'
-or `cursor-sensor-mode' instead. */);
- /* FIXME: We should make-obsolete-variable, but that signals too many
- warnings in code which does (let ((inhibit-point-motion-hooks t)) ...)
- Ideally, make-obsolete-variable should let us specify that only the nil
- value is obsolete, but that requires too many changes in bytecomp.el,
- so for now we'll keep it "obsolete via the docstring". */
+This also inhibits the use of the `intangible' text property. */);
Vinhibit_point_motion_hooks = Qt;
DEFVAR_LISP ("text-property-default-nonsticky",
diff --git a/src/w32fns.c b/src/w32fns.c
index 5f652ae9e4..887e5a1f7b 100644
--- a/src/w32fns.c
+++ b/src/w32fns.c
@@ -1717,10 +1717,19 @@ w32_set_tab_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
w32_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
@@ -2734,8 +2743,7 @@ setup_w32_kbdhook (void)
int i;
CoCreateGuid (&guid);
- StringFromGUID2 (&guid, newTitle, 64);
- if (newTitle != NULL)
+ if (oldTitle != NULL && StringFromGUID2 (&guid, newTitle, 64))
{
GetConsoleTitleW (oldTitle, 1024);
SetConsoleTitleW (newTitle);
@@ -5786,13 +5794,7 @@ w32_default_font_parameter (struct frame *f, Lisp_Object
parms)
if (NILP (font))
error ("No suitable font was found");
}
- else if (!NILP (font_param))
- {
- /* Remember the explicit font parameter, so we can re-apply it after
- we've applied the `default' face settings. */
- gui_set_frame_parameters (f, Fcons (Fcons (Qfont_parameter, font_param),
- Qnil));
- }
+
gui_default_parameter (f, parms, Qfont, font, "font", "Font",
RES_TYPE_STRING);
}
@@ -8418,7 +8420,7 @@ a ShowWindow flag:
current_dir = ENCODE_FILE (current_dir);
/* Cannot use filename_to_utf16/ansi with DOCUMENT, since it could
- be a URL that is not limited to MAX_PATH chararcters. */
+ be a URL that is not limited to MAX_PATH characters. */
doclen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags,
SSDATA (document), -1, NULL, 0);
doc_w = xmalloc (doclen * sizeof (wchar_t));
diff --git a/src/w32inevt.c b/src/w32inevt.c
index 6a1d9afacf..d13b0521c9 100644
--- a/src/w32inevt.c
+++ b/src/w32inevt.c
@@ -648,7 +648,7 @@ handle_file_notifications (struct input_event *hold_quit)
ns = NULL;
/* Find out if there is a record available in the linked list of
- notifications sets. If so, unlink te set from the linked list.
+ notifications sets. If so, unlink the set from the linked list.
Use the critical section. */
enter_crit ();
if (notifications_set_head->next != notifications_set_head)
diff --git a/src/widget.c b/src/widget.c
index 5a75cdaca8..aaab33b6d8 100644
--- a/src/widget.c
+++ b/src/widget.c
@@ -195,7 +195,7 @@ round_size_to_char (EmacsFrame ew, Dimension in_width,
Dimension in_height,
out_width, out_height);
}
-static Widget
+static WMShellWidget
get_wm_shell (Widget w)
{
Widget wmshell;
@@ -204,7 +204,7 @@ get_wm_shell (Widget w)
wmshell && !XtIsWMShell (wmshell);
wmshell = XtParent (wmshell));
- return wmshell;
+ return (WMShellWidget) wmshell;
}
#if 0 /* Currently not used. */
@@ -269,8 +269,8 @@ set_frame_size (EmacsFrame ew)
(f, build_string ("set_frame_size"));
}
-static void
-update_wm_hints (Widget wmshell, EmacsFrame ew)
+static bool
+update_wm_hints (WMShellWidget wmshell, EmacsFrame ew)
{
int cw;
int ch;
@@ -280,6 +280,12 @@ update_wm_hints (Widget wmshell, EmacsFrame ew)
int char_height;
int base_width;
int base_height;
+ char buffer[sizeof wmshell->wm.size_hints];
+ char *hints_ptr;
+
+ /* Copy the old size hints to the buffer. */
+ memcpy (buffer, &wmshell->wm.size_hints,
+ sizeof wmshell->wm.size_hints);
pixel_to_char_size (ew, ew->core.width, ew->core.height,
&char_width, &char_height);
@@ -292,27 +298,29 @@ update_wm_hints (Widget wmshell, EmacsFrame ew)
base_height = (wmshell->core.height - ew->core.height
+ (rounded_height - (char_height * ch)));
- /* Ensure that Xt actually sets window manager hint flags specified
- by the caller by making sure XtNminWidth (a relatively harmless
- resource) always changes each time this function is invoked. */
- ew->emacs_frame.size_switch = !ew->emacs_frame.size_switch;
-
- XtVaSetValues (wmshell,
+ XtVaSetValues ((Widget) wmshell,
XtNbaseWidth, (XtArgVal) base_width,
XtNbaseHeight, (XtArgVal) base_height,
XtNwidthInc, (XtArgVal) (frame_resize_pixelwise ? 1 : cw),
XtNheightInc, (XtArgVal) (frame_resize_pixelwise ? 1 : ch),
- XtNminWidth, (XtArgVal) (base_width
- + ew->emacs_frame.size_switch),
- XtNminHeight, (XtArgVal) (base_height
- + ew->emacs_frame.size_switch),
+ XtNminWidth, (XtArgVal) base_width,
+ XtNminHeight, (XtArgVal) base_height,
NULL);
+
+ /* Return if size hints really changed. If they did not, then Xt
+ probably didn't set them either (or take the flags into
+ account.) */
+ hints_ptr = (char *) &wmshell->wm.size_hints;
+
+ /* Skip flags, which is unsigned long. */
+ return memcmp (hints_ptr + sizeof (long), buffer + sizeof (long),
+ sizeof wmshell->wm.wm_hints - sizeof (long));
}
-void
+bool
widget_update_wm_size_hints (Widget widget, Widget frame)
{
- update_wm_hints (widget, (EmacsFrame) frame);
+ return update_wm_hints ((WMShellWidget) widget, (EmacsFrame) frame);
}
static void
@@ -357,8 +365,6 @@ EmacsFrameInitialize (Widget request, Widget new,
exit (1);
}
- ew->emacs_frame.size_switch = 1;
-
update_from_various_frame_slots (ew);
set_frame_size (ew);
}
diff --git a/src/widget.h b/src/widget.h
index 2906d5ff9e..cf83cb1078 100644
--- a/src/widget.h
+++ b/src/widget.h
@@ -97,6 +97,6 @@ extern struct _DisplayContext *display_context;
/* Special entry points */
void EmacsFrameSetCharSize (Widget, int, int);
void widget_store_internal_border (Widget widget);
-void widget_update_wm_size_hints (Widget widget, Widget frame);
+bool widget_update_wm_size_hints (Widget widget, Widget frame);
#endif /* _EmacsFrame_h */
diff --git a/src/widgetprv.h b/src/widgetprv.h
index fe960326b0..3a4d9206ff 100644
--- a/src/widgetprv.h
+++ b/src/widgetprv.h
@@ -49,9 +49,6 @@ typedef struct {
Boolean visual_bell; /* flash instead of beep */
int bell_volume; /* how loud is beep */
- int size_switch; /* hack to make setting size
- hints work correctly */
-
/* private state */
} EmacsFramePart;
diff --git a/src/window.c b/src/window.c
index da80fabe33..f116b9a9d7 100644
--- a/src/window.c
+++ b/src/window.c
@@ -52,6 +52,7 @@ static ptrdiff_t get_leaf_windows (struct window *, struct
window **,
ptrdiff_t);
static void window_scroll_pixel_based (Lisp_Object, int, bool, bool);
static void window_scroll_line_based (Lisp_Object, int, bool, bool);
+static void window_scroll_for_long_lines (struct window *, int, bool);
static void foreach_window (struct frame *,
bool (* fn) (struct window *, void *),
void *);
@@ -5440,12 +5441,13 @@ window_wants_mode_line (struct window *w)
* Return 1 if window W wants a header line and is high enough to
* accommodate it, 0 otherwise.
*
- * W wants a header line if it's a leaf window and neither a minibuffer
- * nor a pseudo window. Moreover, its 'window-mode-line-format'
- * parameter must not be 'none' and either that parameter or W's
- * buffer's 'mode-line-format' value must be non-nil. Finally, W must
- * be higher than its frame's canonical character height and be able to
- * accommodate a mode line too if necessary (the mode line prevails).
+ * W wants a header line if it's a leaf window and neither a
+ * minibuffer nor a pseudo window. Moreover, its
+ * 'window-header-line-format' parameter must not be 'none' and either
+ * that parameter or W's buffer's 'header-line-format' value must be
+ * non-nil. Finally, W must be higher than its frame's canonical
+ * character height and be able to accommodate a mode line too if
+ * necessary (the mode line prevails).
*/
bool
window_wants_header_line (struct window *w)
@@ -5473,9 +5475,9 @@ window_wants_header_line (struct window *w)
* accommodate it, 0 otherwise.
*
* W wants a tab line if it's a leaf window and neither a minibuffer
- * nor a pseudo window. Moreover, its 'window-mode-line-format'
+ * nor a pseudo window. Moreover, its 'window-tab-line-format'
* parameter must not be 'none' and either that parameter or W's
- * buffer's 'mode-line-format' value must be non-nil. Finally, W must
+ * buffer's 'tab-line-format' value must be non-nil. Finally, W must
* be higher than its frame's canonical character height and be able
* to accommodate a mode line and a header line too if necessary (the
* mode line and a header line prevail).
@@ -5536,19 +5538,40 @@ window_internal_height (struct window *w)
static void
window_scroll (Lisp_Object window, EMACS_INT n, bool whole, bool noerror)
{
+ struct window *w = XWINDOW (window);
+ struct buffer *b = XBUFFER (w->contents);
+ bool long_lines_truncated =
+ b->long_line_optimizations_p && !NILP (BVAR (b, truncate_lines));
specpdl_ref count = SPECPDL_INDEX ();
n = clip_to_bounds (INT_MIN, n, INT_MAX);
- wset_redisplay (XWINDOW (window));
+ wset_redisplay (w);
+
+ /* Does this window's buffer have very long and truncated lines? */
+ if (b->long_line_optimizations_p
+ && !long_lines_truncated
+ && !NILP (Vtruncate_partial_width_windows)
+ && w->total_cols < FRAME_COLS (XFRAME (WINDOW_FRAME (w))))
+ {
+ if (FIXNUMP (Vtruncate_partial_width_windows))
+ long_lines_truncated =
+ w->total_cols < XFIXNAT (Vtruncate_partial_width_windows);
+ else
+ long_lines_truncated = true;
+ }
- if (whole && fast_but_imprecise_scrolling)
+ if (whole && (fast_but_imprecise_scrolling || long_lines_truncated))
specbind (Qfontification_functions, Qnil);
- /* On GUI frames, use the pixel-based version which is much slower
- than the line-based one but can handle varying line heights. */
- if (FRAME_WINDOW_P (XFRAME (XWINDOW (window)->frame)))
+ if (whole && long_lines_truncated)
+ window_scroll_for_long_lines (w, n, noerror);
+ else if (FRAME_WINDOW_P (XFRAME (XWINDOW (window)->frame)))
{
+
+ /* On GUI frames, use the pixel-based version which is much
+ slower than the line-based one, but can handle varying
+ line heights. */
record_unwind_protect_void (unwind_display_working_on_window);
display_working_on_window_p = true;
window_scroll_pixel_based (window, n, whole, noerror);
@@ -5598,6 +5621,71 @@ sanitize_next_screen_context_lines (void)
return clip_to_bounds (0, next_screen_context_lines, 1000000);
}
+/* Implementation of window_scroll for very long and truncated lines.
+ This is a simplified version, it only handles WHOLE window scrolls,
+ and doesn't honor scroll-preserve-screen-position nor scroll-margin. */
+static void
+window_scroll_for_long_lines (struct window *w, int n, bool noerror)
+{
+ ptrdiff_t startpos = marker_position (w->start);
+ ptrdiff_t startbyte = marker_byte_position (w->start);
+ int nscls = sanitize_next_screen_context_lines ();
+ register int ht = window_internal_height (w);
+
+ n *= max (1, ht - nscls);
+
+ /* If point is not visible in window, bring it inside window. */
+ struct position pos;
+ int rtop, rbot, dummy_rowh, dummy_vpos, dummy_x, dummy_y;
+ if (!(PT >= startpos
+ && PT <= ZV
+ && startpos <= ZV
+ && pos_visible_p (w, PT, &dummy_x, &dummy_y, &rtop, &rbot, &dummy_rowh,
+ &dummy_vpos)
+ && !rtop && !rbot))
+ {
+ pos = *vmotion (PT, PT_BYTE, - (ht / 2), w);
+ startpos = pos.bufpos;
+ startbyte = pos.bytepos;
+ }
+ SET_PT_BOTH (startpos, startbyte);
+
+ bool lose = n < 0 && PT == BEGV;
+ pos = *vmotion (PT, PT_BYTE, n, w);
+ if (lose)
+ {
+ if (noerror)
+ return;
+ else
+ xsignal0 (Qbeginning_of_buffer);
+ }
+
+ bool bolp = pos.bufpos == BEGV || FETCH_BYTE (pos.bytepos - 1) == '\n';
+ if (pos.bufpos < ZV)
+ {
+ set_marker_restricted_both (w->start, w->contents,
+ pos.bufpos, pos.bytepos);
+ w->start_at_line_beg = bolp;
+ wset_update_mode_line (w);
+ /* Set force_start so that redisplay_window will run
+ the window-scroll-functions. */
+ w->force_start = true;
+ SET_PT_BOTH (pos.bufpos, pos.bytepos);
+ if (n > 0)
+ pos = *vmotion (PT, PT_BYTE, ht / 2, w);
+ else if (n < 0)
+ pos = *vmotion (PT, PT_BYTE, - (ht / 2), w);
+ SET_PT_BOTH (pos.bufpos, pos.bytepos);
+ }
+ else
+ {
+ if (noerror)
+ return;
+ else
+ xsignal0 (Qend_of_buffer);
+ }
+}
+
/* Implementation of window_scroll that works based on pixel line
heights. See the comment of window_scroll for parameter
descriptions. */
diff --git a/src/window.h b/src/window.h
index 93817a9544..b5d0c69ab5 100644
--- a/src/window.h
+++ b/src/window.h
@@ -1212,6 +1212,16 @@ output_cursor_to (struct window *w, int vpos, int hpos,
int y, int x)
w->output_cursor.y = y;
}
+/* Return true, if overlay OV's properties should have an effect in
+ window W. */
+INLINE bool
+overlay_matches_window (const struct window *w, Lisp_Object ov)
+{
+ eassert (OVERLAYP (ov));
+ Lisp_Object window = Foverlay_get (ov, Qwindow);
+ return (! WINDOWP (window) || XWINDOW (window) == w);
+}
+
INLINE_HEADER_END
#endif /* not WINDOW_H_INCLUDED */
diff --git a/src/xdisp.c b/src/xdisp.c
index 9534e27843..b5f013ea6a 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -1,7 +1,6 @@
/* Display generation from window structure and buffer text.
-Copyright (C) 1985-1988, 1993-1995, 1997-2022 Free Software Foundation,
-Inc.
+Copyright (C) 1985-2022 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -1159,7 +1158,6 @@ static enum move_it_result
static void get_visually_first_element (struct it *);
static void compute_stop_pos (struct it *);
static int face_before_or_after_it_pos (struct it *, bool);
-static ptrdiff_t next_overlay_change (ptrdiff_t);
static int handle_display_spec (struct it *, Lisp_Object, Lisp_Object,
Lisp_Object, struct text_pos *, ptrdiff_t,
bool);
static int handle_single_display_spec (struct it *, Lisp_Object, Lisp_Object,
@@ -2332,7 +2330,7 @@ pixel_to_glyph_coords (struct frame *f, int pix_x, int
pix_y, int *x, int *y,
text, or we can't tell because W's current matrix is not up to
date. */
-static struct glyph *
+struct glyph *
x_y_to_hpos_vpos (struct window *w, int x, int y, int *hpos, int *vpos,
int *dx, int *dy, int *area)
{
@@ -3344,7 +3342,8 @@ init_iterator (struct it *it, struct window *w,
{
/* Mode lines, menu bar in terminal frames. */
it->first_visible_x = 0;
- it->last_visible_x = body_width = WINDOW_PIXEL_WIDTH (w);
+ it->last_visible_x =
+ WINDOW_PIXEL_WIDTH (w) - WINDOW_RIGHT_DIVIDER_WIDTH (w);
}
else
{
@@ -3412,8 +3411,13 @@ init_iterator (struct it *it, struct window *w,
face = FACE_FROM_ID_OR_NULL (it->f, remapped_base_face_id);
if (face && face->box != FACE_NO_BOX)
{
+ int box_thickness = face->box_vertical_line_width;
it->face_box_p = true;
it->start_of_box_run_p = true;
+ /* Make sure we will have enough horizontal space to add the
+ right box line at the end. */
+ if (box_thickness > 0)
+ it->last_visible_x -= box_thickness;
}
}
@@ -4168,39 +4172,6 @@ compute_stop_pos (struct it *it)
&& it->stop_charpos >= IT_CHARPOS (*it)));
}
-
-/* Return the position of the next overlay change after POS in
- current_buffer. Value is point-max if no overlay change
- follows. This is like `next-overlay-change' but doesn't use
- xmalloc. */
-
-static ptrdiff_t
-next_overlay_change (ptrdiff_t pos)
-{
- ptrdiff_t i, noverlays;
- ptrdiff_t endpos;
- Lisp_Object *overlays;
- USE_SAFE_ALLOCA;
-
- /* Get all overlays at the given position. */
- GET_OVERLAYS_AT (pos, overlays, noverlays, &endpos, true);
-
- /* If any of these overlays ends before endpos,
- use its ending point instead. */
- for (i = 0; i < noverlays; ++i)
- {
- Lisp_Object oend;
- ptrdiff_t oendpos;
-
- oend = OVERLAY_END (overlays[i]);
- oendpos = OVERLAY_POSITION (oend);
- endpos = min (endpos, oendpos);
- }
-
- SAFE_FREE ();
- return endpos;
-}
-
/* How many characters forward to search for a display property or
display string. Searching too far forward makes the bidi display
sluggish, especially in small windows. */
@@ -5359,6 +5330,8 @@ display_min_width (struct it *it, ptrdiff_t bufpos,
/* Insert the stretch glyph. */
it->object = list3 (Qspace, QCwidth, w);
produce_stretch_glyph (it);
+ if (it->area == TEXT_AREA)
+ it->current_x += it->pixel_width;
it->min_width_property = Qnil;
}
}
@@ -5838,7 +5811,7 @@ handle_single_display_spec (struct it *it, Lisp_Object
spec, Lisp_Object object,
overlay's display string/image twice. */
if (!NILP (overlay))
{
- ptrdiff_t ovendpos = OVERLAY_POSITION (OVERLAY_END (overlay));
+ ptrdiff_t ovendpos = OVERLAY_END (overlay);
/* Some borderline-sane Lisp might call us with the current
buffer narrowed so that overlay-end is outside the
@@ -6572,6 +6545,8 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos)
struct overlay_entry entriesbuf[20];
ptrdiff_t size = ARRAYELTS (entriesbuf);
struct overlay_entry *entries = entriesbuf;
+ struct itree_node *node;
+
USE_SAFE_ALLOCA;
if (charpos <= 0)
@@ -6603,27 +6578,24 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos)
} \
while (false)
- /* Process overlay before the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_before;
- ov; ov = ov->next)
+
+ /* Process overlays. */
+ ITREE_FOREACH (node, current_buffer->overlays, charpos - 1, charpos + 1,
DESCENDING)
{
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
+ Lisp_Object overlay = node->data;
eassert (OVERLAYP (overlay));
- ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- if (end < charpos)
- break;
+ ptrdiff_t start = node->begin;
+ ptrdiff_t end = node->end;
/* Skip this overlay if it doesn't start or end at IT's current
- position. */
+ position. */
if (end != charpos && start != charpos)
- continue;
+ continue;
/* Skip this overlay if it doesn't apply to IT->w. */
Lisp_Object window = Foverlay_get (overlay, Qwindow);
if (WINDOWP (window) && XWINDOW (window) != it->w)
- continue;
+ continue;
/* If the text ``under'' the overlay is invisible, both before-
and after-strings from this overlay are visible; start and
@@ -6634,56 +6606,15 @@ load_overlay_strings (struct it *it, ptrdiff_t charpos)
/* If overlay has a non-empty before-string, record it. */
Lisp_Object str;
if ((start == charpos || (end == charpos && invis != 0))
- && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
- && SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, false);
-
- /* If overlay has a non-empty after-string, record it. */
- if ((end == charpos || (start == charpos && invis != 0))
- && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))
- && SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, true);
- }
-
- /* Process overlays after the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_after;
- ov; ov = ov->next)
- {
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
- ptrdiff_t start = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t end = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- if (start > charpos)
- break;
-
- /* Skip this overlay if it doesn't start or end at IT's current
- position. */
- if (end != charpos && start != charpos)
- continue;
-
- /* Skip this overlay if it doesn't apply to IT->w. */
- Lisp_Object window = Foverlay_get (overlay, Qwindow);
- if (WINDOWP (window) && XWINDOW (window) != it->w)
- continue;
-
- /* If the text ``under'' the overlay is invisible, it has a zero
- dimension, and both before- and after-strings apply. */
- Lisp_Object invisible = Foverlay_get (overlay, Qinvisible);
- int invis = TEXT_PROP_MEANS_INVISIBLE (invisible);
-
- /* If overlay has a non-empty before-string, record it. */
- Lisp_Object str;
- if ((start == charpos || (end == charpos && invis != 0))
- && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
- && SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, false);
+ && (str = Foverlay_get (overlay, Qbefore_string), STRINGP (str))
+ && SCHARS (str))
+ RECORD_OVERLAY_STRING (overlay, str, false);
/* If overlay has a non-empty after-string, record it. */
if ((end == charpos || (start == charpos && invis != 0))
- && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))
- && SCHARS (str))
- RECORD_OVERLAY_STRING (overlay, str, true);
+ && (str = Foverlay_get (overlay, Qafter_string), STRINGP (str))
+ && SCHARS (str))
+ RECORD_OVERLAY_STRING (overlay, str, true);
}
#undef RECORD_OVERLAY_STRING
@@ -7088,11 +7019,11 @@ back_to_previous_line_start (struct it *it)
static bool
strings_with_newlines (ptrdiff_t startpos, ptrdiff_t endpos, struct window *w)
{
- /* Process overlays before the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_before;
- ov; ov = ov->next)
+ struct itree_node *node;
+ /* Process overlays. */
+ ITREE_FOREACH (node, current_buffer->overlays, startpos, endpos, DESCENDING)
{
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
+ Lisp_Object overlay = node->data;
eassert (OVERLAYP (overlay));
/* Skip this overlay if it doesn't apply to our window. */
@@ -7100,52 +7031,8 @@ strings_with_newlines (ptrdiff_t startpos, ptrdiff_t
endpos, struct window *w)
if (WINDOWP (window) && XWINDOW (window) != w)
continue;
- ptrdiff_t ostart = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t oend = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- /* Due to the order of overlays in overlays_before, once we get
- to an overlay whose end position is before STARTPOS, all the
- rest also end before STARTPOS, and thus are of no concern to us. */
- if (oend < startpos)
- break;
-
- /* Skip overlays that don't overlap the range. */
- if (!((startpos < oend && ostart < endpos)
- || (ostart == oend
- && (startpos == oend || (endpos == ZV && oend == endpos)))))
- continue;
-
- Lisp_Object str;
- str = Foverlay_get (overlay, Qbefore_string);
- if (STRINGP (str) && SCHARS (str)
- && memchr (SDATA (str), '\n', SBYTES (str)))
- return true;
- str = Foverlay_get (overlay, Qafter_string);
- if (STRINGP (str) && SCHARS (str)
- && memchr (SDATA (str), '\n', SBYTES (str)))
- return true;
- }
-
- /* Process overlays after the overlay center. */
- for (struct Lisp_Overlay *ov = current_buffer->overlays_after;
- ov; ov = ov->next)
- {
- Lisp_Object overlay = make_lisp_ptr (ov, Lisp_Vectorlike);
- eassert (OVERLAYP (overlay));
-
- /* Skip this overlay if it doesn't apply to our window. */
- Lisp_Object window = Foverlay_get (overlay, Qwindow);
- if (WINDOWP (window) && XWINDOW (window) != w)
- continue;
-
- ptrdiff_t ostart = OVERLAY_POSITION (OVERLAY_START (overlay));
- ptrdiff_t oend = OVERLAY_POSITION (OVERLAY_END (overlay));
-
- /* Due to the order of overlays in overlays_after, once we get
- to an overlay whose start position is after ENDPOS, all the
- rest also start after ENDPOS, and thus are of no concern to us. */
- if (ostart > endpos)
- break;
+ ptrdiff_t ostart = node->begin;
+ ptrdiff_t oend = node->end;
/* Skip overlays that don't overlap the range. */
if (!((startpos < oend && ostart < endpos)
@@ -7404,7 +7291,7 @@ back_to_previous_visible_line_start (struct it *it)
&& !NILP (val = get_char_property_and_overlay
(make_fixnum (pos), Qdisplay, Qnil, &overlay))
&& (OVERLAYP (overlay)
- ? (beg = OVERLAY_POSITION (OVERLAY_START (overlay)))
+ ? (beg = OVERLAY_START (overlay))
: get_property_and_range (pos, Qdisplay, &val, &beg, &end,
Qnil)))
{
RESTORE_IT (it, it, it2data);
@@ -10639,7 +10526,6 @@ move_it_to (struct it *it, ptrdiff_t to_charpos, int
to_x, int to_y, int to_vpos
}
/* Reset/increment for the next run. */
- recenter_overlay_lists (current_buffer, IT_CHARPOS (*it));
it->current_x = line_start_x;
line_start_x = 0;
it->hpos = 0;
@@ -13334,7 +13220,10 @@ unwind_format_mode_line (Lisp_Object vector)
if (!EQ (frame, WINDOW_FRAME (XWINDOW (old_window))))
Fselect_window (target_frame_window, Qt);
- if (!NILP (old_top_frame) && !EQ (old_top_frame, frame))
+ if (!NILP (old_top_frame) && !EQ (old_top_frame, frame)
+ /* This could've been destroyed during the formatting,
+ possibly because the terminal was deleted. */
+ && FRAME_LIVE_P (XFRAME (old_top_frame)))
Fselect_frame (old_top_frame, Qt);
}
@@ -13437,6 +13326,7 @@ void
gui_consider_frame_title (Lisp_Object frame)
{
struct frame *f = XFRAME (frame);
+ Lisp_Object format_data;
if ((FRAME_WINDOW_P (f)
|| FRAME_MINIBUF_ONLY_P (f)
@@ -13481,15 +13371,19 @@ gui_consider_frame_title (Lisp_Object frame)
specbind (Qinhibit_redisplay, Qt);
/* Switch to the buffer of selected window of the frame. Set up
- mode_line_target so that display_mode_element will output into
- mode_line_noprop_buf; then display the title. */
- record_unwind_protect (unwind_format_mode_line,
- format_mode_line_unwind_data
- (f, current_buffer, selected_window, false));
+ mode_line_target so that display_mode_element will output
+ into mode_line_noprop_buf; then display the title. Save the
+ original frame and selected window, and possibly the topmost
+ frame of the tty (for tty frames) into a vector; it will be
+ restored later. */
+
+ format_data = format_mode_line_unwind_data (f, current_buffer,
+ selected_window,
+ false);
+ record_unwind_protect (unwind_format_mode_line, format_data);
Fselect_window (f->selected_window, Qt);
- set_buffer_internal_1
- (XBUFFER (XWINDOW (f->selected_window)->contents));
+ set_buffer_internal_1 (XBUFFER (XWINDOW (f->selected_window)->contents));
fmt = FRAME_ICONIFIED_P (f) ? Vicon_title_format : Vframe_title_format;
mode_line_target = MODE_LINE_TITLE;
@@ -13502,8 +13396,9 @@ gui_consider_frame_title (Lisp_Object frame)
/* Make sure that any raw bytes in the title are properly
represented by their multibyte sequences. */
ptrdiff_t nchars = 0;
- len = str_as_multibyte ((unsigned char *)title,
- mode_line_noprop_buf_end - title, len, &nchars);
+ len = str_as_multibyte ((unsigned char *) title,
+ mode_line_noprop_buf_end - title,
+ len, &nchars);
unbind_to (count, Qnil);
/* Set the title only if it's changed. This avoids consing in
@@ -18917,7 +18812,7 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
while (MATRIX_ROW_BOTTOM_Y (row) < last_y
&& MATRIX_ROW_END_CHARPOS (row) == PT
&& row < MATRIX_MODE_LINE_ROW (w->current_matrix)
- && MATRIX_ROW_START_CHARPOS (row+1) == PT
+ && MATRIX_ROW_START_CHARPOS (row+1) >= PT
&& !cursor_row_p (row))
++row;
@@ -19014,7 +18909,12 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
rc = CURSOR_MOVEMENT_SUCCESS;
}
- if (PT < MATRIX_ROW_START_CHARPOS (row)
+ if ((PT < MATRIX_ROW_START_CHARPOS (row)
+ && (row == MATRIX_FIRST_TEXT_ROW (w->current_matrix)
+ /* Don't give up if point is inside invisible text
+ at the beginning of its glyph row. */
+ || (MATRIX_ROW_END_CHARPOS (row-1)
+ == MATRIX_ROW_START_CHARPOS (row))))
|| PT > MATRIX_ROW_END_CHARPOS (row))
{
/* if PT is not in the glyph row, give up. */
@@ -19096,12 +18996,23 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
continuation lines' rows is implemented for
bidi-reordered rows. */
bool rv = false;
+ bool pt_invis = false;
+ Lisp_Object val = get_char_property_and_overlay (make_fixnum (PT),
+ Qinvisible,
+ Qnil, NULL);
+
+ if (TEXT_PROP_MEANS_INVISIBLE (val) != 0)
+ pt_invis = true;
do
{
bool at_zv_p = false, exact_match_p = false;
- if (MATRIX_ROW_START_CHARPOS (row) <= PT
+ /* If point is in invisible text, we cannot assume
+ it must be after row's start position, since the
+ row could have invisible text at its beginning
+ where point is located. */
+ if ((pt_invis || MATRIX_ROW_START_CHARPOS (row) <= PT)
&& PT <= MATRIX_ROW_END_CHARPOS (row)
&& cursor_row_p (row))
rv |= set_cursor_from_row (w, row, w->current_matrix,
@@ -19133,16 +19044,8 @@ try_cursor_movement (Lisp_Object window, struct
text_pos startp,
invisible text? In that case, we trust
'set_cursor_from_row' to do its job and
find the best position for the cursor. */
- if (!exact_match_p)
- {
- Lisp_Object val =
- get_char_property_and_overlay (make_fixnum (PT),
- Qinvisible,
- Qnil, NULL);
-
- if (TEXT_PROP_MEANS_INVISIBLE (val) != 0)
- exact_match_p = true;
- }
+ if (!exact_match_p && pt_invis)
+ exact_match_p = true;
}
if (at_zv_p || exact_match_p)
{
@@ -20165,7 +20068,20 @@ redisplay_window (Lisp_Object window, bool
just_this_one_p)
from point. */
centering_position = window_box_height (w) / 2;
}
- move_it_vertically_backward (&it, centering_position);
+ if (current_buffer->long_line_optimizations_p
+ && it.line_wrap == TRUNCATE)
+ {
+ /* For very long and truncated lines, go back using a simplified
+ method, which ignored any inaccuracies due to line-height
+ differences, display properties/overlays, etc. */
+ int nlines = centering_position / frame_line_height;
+
+ while (nlines-- && IT_CHARPOS (it) > BEGV)
+ back_to_previous_visible_line_start (&it);
+ reseat_1 (&it, it.current.pos, true);
+ }
+ else
+ move_it_vertically_backward (&it, centering_position);
eassert (IT_CHARPOS (it) >= BEGV);
@@ -23239,10 +23155,18 @@ extend_face_to_end_of_line (struct it *it)
this is called when redisplaying a non-selected window, with
point temporarily moved to window-point. */
specbind (Qinhibit_quit, Qt);
- const int extend_face_id = (it->face_id == DEFAULT_FACE_ID
- || it->s != NULL)
- ? DEFAULT_FACE_ID
- : face_at_pos (it, LFACE_EXTEND_INDEX);
+ /* The default face, possibly remapped. */
+ struct face *default_face =
+ FACE_FROM_ID_OR_NULL (f, lookup_basic_face (it->w, f, DEFAULT_FACE_ID));
+ if (!default_face)
+ return;
+
+ const int extend_face_id =
+ (it->face_id == default_face->id || it->s != NULL)
+ ? it->face_id
+ : (it->glyph_row->ends_at_zv_p
+ ? default_face->id
+ : face_at_pos (it, LFACE_EXTEND_INDEX));
unbind_to (count, Qnil);
/* Face extension extends the background and box of IT->extend_face_id
@@ -23279,14 +23203,8 @@ extend_face_to_end_of_line (struct it *it)
if (!ASCII_CHAR_P (it->c))
it->face_id = FACE_FOR_CHAR (f, face, 0, -1, Qnil);
- /* The default face, possibly remapped. */
- struct face *default_face =
- FACE_FROM_ID (f, lookup_basic_face (it->w, f, DEFAULT_FACE_ID));
#ifdef HAVE_WINDOW_SYSTEM
- if (default_face == NULL)
- error ("extend_face_to_end_of_line: default_face is not set!");
-
if (FRAME_WINDOW_P (f))
{
/* If the row is empty, add a space with the current face of IT,
@@ -24588,13 +24506,6 @@ display_line (struct it *it, int cursor_vpos)
it->stretch_adjust = 0;
it->line_number_produced_p = false;
- /* Arrange the overlays nicely for our purposes. Usually, we call
- display_line on only one line at a time, in which case this
- can't really hurt too much, or we call it on lines which appear
- one after another in the buffer, in which case all calls to
- recenter_overlay_lists but the first will be pretty cheap. */
- recenter_overlay_lists (current_buffer, IT_CHARPOS (*it));
-
/* If we are going to display the cursor's line, account for the
hscroll of that line. We subtract the window's min_hscroll,
because that was already accounted for in init_iterator. */
@@ -26809,7 +26720,17 @@ display_mode_line (struct window *w, enum face_id
face_id, Lisp_Object format)
{
struct glyph *last = (it.glyph_row->glyphs[TEXT_AREA]
+ it.glyph_row->used[TEXT_AREA] - 1);
+ int box_thickness = face->box_vertical_line_width;
last->right_box_line_p = true;
+ /* Add back the space for the right box line we subtracted in
+ init_iterator, since the right_box_line_p flag will make the
+ glyph wider. We actually add only as much space as is
+ available for the last glyph of the modeline and whatever
+ space is left beyond it, since that glyph could be only
+ partially visible */
+ if (box_thickness > 0)
+ last->pixel_width += max (0, (box_thickness
+ - (it.current_x - it.last_visible_x)));
}
return it.glyph_row->height;
@@ -33655,8 +33576,14 @@ coords_in_mouse_face_p (struct window *w, int hpos,
int vpos)
bool
cursor_in_mouse_face_p (struct window *w)
{
- int hpos = w->phys_cursor.hpos;
int vpos = w->phys_cursor.vpos;
+
+ /* If the cursor is outside the matrix glyph rows, it cannot be
+ within the mouse face. */
+ if (!(0 <= vpos && vpos < w->current_matrix->nrows))
+ return false;
+
+ int hpos = w->phys_cursor.hpos;
struct glyph_row *row = MATRIX_ROW (w->current_matrix, vpos);
/* When the window is hscrolled, cursor hpos can legitimately be out
@@ -34899,7 +34826,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
struct buffer *b;
/* When a menu is active, don't highlight because this looks odd. */
-#if defined (USE_X_TOOLKIT) || (defined (USE_GTK) && !defined (HAVE_PGTK)) ||
defined (HAVE_NS) || defined (MSDOS)
+#if defined (HAVE_X_WINDOWS) || defined (HAVE_NS) || defined (MSDOS)
if (popup_activated ())
return;
#endif
@@ -35226,7 +35153,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
if (BUFFERP (object))
{
/* Put all the overlays we want in a vector in overlay_vec. */
- GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL, false);
+ GET_OVERLAYS_AT (pos, overlay_vec, noverlays, NULL);
/* Sort overlays into increasing priority order. */
noverlays = sort_overlays (overlay_vec, noverlays, w);
}
@@ -35254,7 +35181,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
|| (!hlinfo->mouse_face_hidden
&& OVERLAYP (hlinfo->mouse_face_overlay)
/* It's possible the overlay was deleted (Bug#35273). */
- && XMARKER (OVERLAY_START (hlinfo->mouse_face_overlay))->buffer
+ && OVERLAY_BUFFER (hlinfo->mouse_face_overlay)
&& mouse_face_overlay_overlaps (hlinfo->mouse_face_overlay)))
{
/* Find the highest priority overlay with a mouse-face. */
diff --git a/src/xfaces.c b/src/xfaces.c
index 5e3a47d7f8..df078227c8 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -3809,8 +3809,12 @@ set_font_frame_param (Lisp_Object frame, Lisp_Object
lface)
ASET (lface, LFACE_FONT_INDEX, font);
}
f->default_face_done_p = false;
- AUTO_FRAME_ARG (arg, Qfont, font);
- Fmodify_frame_parameters (frame, arg);
+ AUTO_LIST2 (arg, AUTO_CONS_EXPR (Qfont, font),
+ /* Clear the `font-parameter' frame property, as the
+ font is now being specified by a face, not a
+ frame property. */
+ AUTO_CONS_EXPR (Qfont_parameter, Qnil));
+ gui_set_frame_parameters_1 (f, arg, true);
}
}
@@ -4208,7 +4212,17 @@ Default face attributes override any local face
attributes. */)
{
Lisp_Object name = newface->font->props[FONT_NAME_INDEX];
AUTO_FRAME_ARG (arg, Qfont, name);
- Fmodify_frame_parameters (frame, arg);
+
+#ifdef HAVE_WINDOW_SYSTEM
+ if (FRAME_WINDOW_P (f))
+ /* This is a window-system frame. Prevent changes of
+ the `font' parameter here from messing with the
+ `font-parameter' frame property, as the frame
+ parameter is not being changed by the user. */
+ gui_set_frame_parameters_1 (f, arg, true);
+ else
+#endif
+ Fmodify_frame_parameters (frame, arg);
}
if (STRINGP (gvec[LFACE_FOREGROUND_INDEX]))
@@ -6540,8 +6554,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
USE_SAFE_ALLOCA;
{
ptrdiff_t next_overlay;
-
- GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay, false);
+ GET_OVERLAYS_AT (pos, overlay_vec, noverlays, &next_overlay);
if (next_overlay < endpos)
endpos = next_overlay;
}
@@ -6594,7 +6607,6 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
{
for (prop = Qnil, i = noverlays - 1; i >= 0 && NILP (prop); --i)
{
- Lisp_Object oend;
ptrdiff_t oendpos;
prop = Foverlay_get (overlay_vec[i], propname);
@@ -6607,8 +6619,7 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
merge_face_ref (w, f, prop, attrs, true, NULL, attr_filter);
}
- oend = OVERLAY_END (overlay_vec[i]);
- oendpos = OVERLAY_POSITION (oend);
+ oendpos = OVERLAY_END (overlay_vec[i]);
if (oendpos < endpos)
endpos = oendpos;
}
@@ -6617,7 +6628,6 @@ face_at_buffer_position (struct window *w, ptrdiff_t pos,
{
for (i = 0; i < noverlays; i++)
{
- Lisp_Object oend;
ptrdiff_t oendpos;
prop = Foverlay_get (overlay_vec[i], propname);
@@ -6625,11 +6635,10 @@ face_at_buffer_position (struct window *w, ptrdiff_t
pos,
if (!NILP (prop))
merge_face_ref (w, f, prop, attrs, true, NULL, attr_filter);
- oend = OVERLAY_END (overlay_vec[i]);
- oendpos = OVERLAY_POSITION (oend);
- if (oendpos < endpos)
- endpos = oendpos;
- }
+ oendpos = OVERLAY_END (overlay_vec[i]);
+ if (oendpos < endpos)
+ endpos = oendpos;
+ }
}
*endptr = endpos;
diff --git a/src/xfns.c b/src/xfns.c
index 8cea93c669..95092ce05f 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -1362,13 +1362,21 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg,
Lisp_Object oldval)
char *xmessage = alloca (1 + message_length);
memcpy (xmessage, cursor_data.error_string, message_length);
- x_uncatch_errors ();
+ x_uncatch_errors_after_check ();
+
+ /* XFreeCursor can generate BadCursor errors, because
+ XCreateFontCursor is not a request that waits for a reply,
+ and as such can return IDs that will not actually be used by
+ the server. */
+ x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f));
/* Free any successfully created cursors. */
for (i = 0; i < mouse_cursor_max; i++)
if (cursor_data.cursor[i] != 0)
XFreeCursor (dpy, cursor_data.cursor[i]);
+ x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f));
+
/* This should only be able to fail if the server's serial
number tracking is broken. */
if (cursor_data.error_cursor >= 0)
@@ -1750,10 +1758,19 @@ x_set_tab_bar_lines (struct frame *f, Lisp_Object
value, Lisp_Object oldval)
void
x_change_tab_bar_height (struct frame *f, int height)
{
- int unit = FRAME_LINE_HEIGHT (f);
- int old_height = FRAME_TAB_BAR_HEIGHT (f);
- int lines = (height + unit - 1) / unit;
- Lisp_Object fullscreen = get_frame_param (f, Qfullscreen);
+ int unit, old_height, lines;
+ Lisp_Object fullscreen;
+
+ unit = FRAME_LINE_HEIGHT (f);
+ old_height = FRAME_TAB_BAR_HEIGHT (f);
+ fullscreen = get_frame_param (f, Qfullscreen);
+
+ /* This differs from the tool bar code in that the tab bar height is
+ not rounded up. Otherwise, if redisplay_tab_bar decides to grow
+ the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed,
+ leading to the tab bar height being incorrectly set upon the next
+ call to x_set_font. (bug#59285) */
+ lines = height / unit;
/* Make sure we redisplay all windows in this frame. */
fset_redisplay (f);
@@ -4179,11 +4196,15 @@ x_window (struct frame *f)
{
/* XIM server might require some X events. */
unsigned long fevent = NoEventMask;
- XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
- attributes.event_mask |= fevent;
- attribute_mask = CWEventMask;
- XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
- attribute_mask, &attributes);
+
+ if (fevent)
+ {
+ XGetICValues (FRAME_XIC (f), XNFilterEvents, &fevent, NULL);
+ attributes.event_mask |= fevent;
+ attribute_mask = CWEventMask;
+ XChangeWindowAttributes (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ attribute_mask, &attributes);
+ }
}
}
#endif /* HAVE_X_I18N */
@@ -4502,9 +4523,11 @@ x_default_font_parameter (struct frame *f, Lisp_Object
parms)
}
if (NILP (font))
- font = !NILP (font_param) ? font_param
- : gui_display_get_arg (dpyinfo, parms, Qfont, "font", "Font",
- RES_TYPE_STRING);
+ font = (!NILP (font_param)
+ ? font_param
+ : gui_display_get_arg (dpyinfo, parms,
+ Qfont, "font", "Font",
+ RES_TYPE_STRING));
if (! FONTP (font) && ! STRINGP (font))
{
@@ -4536,13 +4559,6 @@ x_default_font_parameter (struct frame *f, Lisp_Object
parms)
if (NILP (font))
error ("No suitable font was found");
}
- else if (!NILP (font_param))
- {
- /* Remember the explicit font parameter, so we can re-apply it after
- we've applied the `default' face settings. */
- AUTO_FRAME_ARG (arg, Qfont_parameter, font_param);
- gui_set_frame_parameters (f, arg);
- }
/* This call will make X resources override any system font setting. */
gui_default_parameter (f, parms, Qfont, font, "font", "Font",
RES_TYPE_STRING);
@@ -7909,7 +7925,7 @@ Otherwise, the return value is a vector with the
following fields:
DEFUN ("x-translate-coordinates", Fx_translate_coordinates,
Sx_translate_coordinates,
- 1, 5, 0, doc: /* Translate coordinates from FRAME.
+ 1, 6, 0, doc: /* Translate coordinates from FRAME.
Translate the given coordinates SOURCE-X and SOURCE-Y from
SOURCE-WINDOW's coordinate space to that of DEST-WINDOW, on FRAME.
@@ -7925,16 +7941,21 @@ Return a list of (X Y CHILD) if the given coordinates
are on the same
screen, or nil otherwise, where X and Y are the coordinates in
DEST-WINDOW's coordinate space, and CHILD is the window ID of any
mapped child in DEST-WINDOW at those coordinates, or nil if there is
-no such window. */)
+no such window. If REQUIRE-CHILD is nil, avoid fetching CHILD if it
+would result in an avoidable request to the X server, thereby
+improving performance when the X connection is over a slow network.
+Otherwise, always obtain the mapped child window from the X
+server. */)
(Lisp_Object frame, Lisp_Object source_window,
Lisp_Object dest_window, Lisp_Object source_x,
- Lisp_Object source_y)
+ Lisp_Object source_y, Lisp_Object require_child)
{
struct x_display_info *dpyinfo;
struct frame *source_frame;
int dest_x, dest_y;
Window child_return, src, dest;
Bool rc;
+ Lisp_Object temp_result;
dpyinfo = check_x_display_info (frame);
dest_x = 0;
@@ -7952,6 +7973,8 @@ no such window. */)
dest_y = XFIXNUM (source_y);
}
+ source_frame = NULL;
+
if (!NILP (source_window))
CONS_TO_INTEGER (source_window, Window, src);
else
@@ -7960,6 +7983,17 @@ no such window. */)
src = FRAME_X_WINDOW (source_frame);
}
+ /* If require_child is nil, try to avoid an avoidable roundtrip to
+ the X server. */
+ if (NILP (require_child) && source_frame)
+ {
+ temp_result
+ = x_handle_translate_coordinates (source_frame, dest_window, dest_x,
+ dest_y);
+ if (!NILP (temp_result))
+ return temp_result;
+ }
+
if (!src)
src = dpyinfo->root_window;
@@ -8439,7 +8473,17 @@ compute_tip_xy (struct frame *f, Lisp_Object parms,
Lisp_Object dx,
unblock_input ();
XSETFRAME (frame, f);
- attributes = Fx_display_monitor_attributes_list (frame);
+
+#if defined HAVE_XRANDR || defined USE_GTK
+ if (!NILP (FRAME_DISPLAY_INFO (f)->last_monitor_attributes_list))
+ /* Use cached values if available to avoid fetching the
+ monitor list from the X server. If XRandR is not
+ available, then fetching the attributes will probably not
+ sync anyway, and will thus be relatively harmless. */
+ attributes = FRAME_DISPLAY_INFO (f)->last_monitor_attributes_list;
+ else
+#endif
+ attributes = Fx_display_monitor_attributes_list (frame);
/* Try to determine the monitor where the mouse pointer is and
its geometry. See bug#22549. */
@@ -8689,9 +8733,6 @@ Text larger than the specified size is clipped. */)
int old_windows_or_buffers_changed = windows_or_buffers_changed;
specpdl_ref count = SPECPDL_INDEX ();
Lisp_Object window, size, tip_buf;
- Window child;
- XWindowAttributes child_attrs;
- int dest_x_return, dest_y_return;
bool displayed;
#ifdef ENABLE_CHECKING
struct glyph_row *row, *end;
@@ -8942,41 +8983,6 @@ Text larger than the specified size is clipped. */)
/* Show tooltip frame. */
block_input ();
- /* If the display is composited, then WM_TRANSIENT_FOR must be set
- as well, or else the compositing manager won't display
- decorations correctly, even though the tooltip window is override
- redirect. See
- https://specifications.freedesktop.org/wm-spec/1.4/ar01s08.html
-
- Perhaps WM_TRANSIENT_FOR should be used in place of
- override-redirect anyway. The ICCCM only recommends
- override-redirect if the pointer will be grabbed. */
-
- if (XTranslateCoordinates (FRAME_X_DISPLAY (f),
- FRAME_DISPLAY_INFO (f)->root_window,
- FRAME_DISPLAY_INFO (f)->root_window,
- root_x, root_y, &dest_x_return,
- &dest_y_return, &child)
- && child != None)
- {
- /* But only if the child is not override-redirect, which can
- happen if the pointer is above a menu. */
-
- if (XGetWindowAttributes (FRAME_X_DISPLAY (f),
- child, &child_attrs)
- || child_attrs.override_redirect)
- XDeleteProperty (FRAME_X_DISPLAY (tip_f),
- FRAME_X_WINDOW (tip_f),
- FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for);
- else
- XSetTransientForHint (FRAME_X_DISPLAY (tip_f),
- FRAME_X_WINDOW (tip_f), child);
- }
- else
- XDeleteProperty (FRAME_X_DISPLAY (tip_f),
- FRAME_X_WINDOW (tip_f),
- FRAME_DISPLAY_INFO (tip_f)->Xatom_wm_transient_for);
-
#ifndef USE_XCB
XMoveResizeWindow (FRAME_X_DISPLAY (tip_f), FRAME_X_WINDOW (tip_f),
root_x, root_y, width, height);
@@ -9448,13 +9454,21 @@ usual X keysyms. Value is `lambda' if we cannot
determine if both keys are
present and mapped to the usual X keysyms. */)
(Lisp_Object frame)
{
+#ifdef HAVE_XKB
+ XkbDescPtr kb;
+ struct frame *f;
+ Display *dpy;
+ Lisp_Object have_keys;
+ int delete_keycode, backspace_keycode, i;
+#endif
+
#ifndef HAVE_XKB
return Qlambda;
#else
- XkbDescPtr kb;
- struct frame *f = decode_window_system_frame (frame);
- Display *dpy = FRAME_X_DISPLAY (f);
- Lisp_Object have_keys;
+ delete_keycode = 0;
+ backspace_keycode = 0;
+ f = decode_window_system_frame (frame);
+ dpy = FRAME_X_DISPLAY (f);
if (!FRAME_DISPLAY_INFO (f)->supports_xkb)
return Qlambda;
@@ -9470,50 +9484,39 @@ present and mapped to the usual X keysyms. */)
XK_Delete are mapped to any key. But if any of those are mapped to
some non-intuitive key combination (Meta-Shift-Ctrl-whatever) and the
user doesn't know about it, it is better to return false here.
- It is more obvious to the user what to do if she/he has two keys
+ It is more obvious to the user what to do if there are two keys
clearly marked with names/symbols and one key does something not
- expected (i.e. she/he then tries the other).
+ expected (and the user then tries the other).
The cases where Backspace/Delete is mapped to some other key combination
are rare, and in those cases, normal-erase-is-backspace can be turned on
manually. */
have_keys = Qnil;
- kb = XkbGetMap (dpy, XkbAllMapComponentsMask, XkbUseCoreKbd);
- if (kb)
+ kb = FRAME_DISPLAY_INFO (f)->xkb_desc;
+ if (kb && kb->names)
{
- int delete_keycode = 0, backspace_keycode = 0, i;
-
- if (XkbGetNames (dpy, XkbAllNamesMask, kb) == Success)
+ for (i = kb->min_key_code; (i < kb->max_key_code
+ && (delete_keycode == 0
+ || backspace_keycode == 0));
+ ++i)
{
- for (i = kb->min_key_code;
- (i < kb->max_key_code
- && (delete_keycode == 0 || backspace_keycode == 0));
- ++i)
- {
- /* The XKB symbolic key names can be seen most easily in
- the PS file generated by `xkbprint -label name
- $DISPLAY'. */
- if (memcmp ("DELE", kb->names->keys[i].name, 4) == 0)
- delete_keycode = i;
- else if (memcmp ("BKSP", kb->names->keys[i].name, 4) == 0)
- backspace_keycode = i;
- }
-
- XkbFreeNames (kb, 0, True);
+ /* The XKB symbolic key names can be seen most easily in
+ the PS file generated by `xkbprint -label name
+ $DISPLAY'. */
+ if (!memcmp ("DELE", kb->names->keys[i].name, 4))
+ delete_keycode = i;
+ else if (!memcmp ("BKSP", kb->names->keys[i].name, 4))
+ backspace_keycode = i;
}
- /* As of libX11-1.6.2, XkbGetMap manual says that you should use
- XkbFreeClientMap to free the data returned by XkbGetMap. But
- this function just frees the data referenced from KB and not
- KB itself. To free KB as well, call XkbFreeKeyboard. */
- XkbFreeKeyboard (kb, XkbAllMapComponentsMask, True);
-
- if (delete_keycode
- && backspace_keycode
+ if (delete_keycode && backspace_keycode
&& XKeysymToKeycode (dpy, XK_Delete) == delete_keycode
&& XKeysymToKeycode (dpy, XK_BackSpace) == backspace_keycode)
have_keys = Qt;
}
+ else
+ /* The keyboard names couldn't be obtained for some reason. */
+ have_keys = Qlambda;
unblock_input ();
return have_keys;
#endif
diff --git a/src/xmenu.c b/src/xmenu.c
index 1452b3c6d1..756842c2fe 100644
--- a/src/xmenu.c
+++ b/src/xmenu.c
@@ -294,10 +294,13 @@ x_menu_translate_generic_event (XEvent *event)
#endif
#if !defined USE_X_TOOLKIT && !defined USE_GTK
-static void
-x_menu_expose_event (XEvent *event)
+static int
+x_menu_dispatch_event (XEvent *event)
{
x_dispatch_event (event, event->xexpose.display);
+
+ /* The return doesn't really matter. */
+ return 0;
}
#endif
#endif /* ! MSDOS */
@@ -1521,26 +1524,15 @@ create_and_show_popup_menu (struct frame *f,
widget_value *first_wv,
if (use_pos_func)
{
- Window dummy_window;
-
/* Not invoked by a click. pop up at x/y. */
pos_func = menu_position_func;
/* Adjust coordinates to be root-window-relative. */
block_input ();
- XTranslateCoordinates (FRAME_X_DISPLAY (f),
-
- /* From-window, to-window. */
- FRAME_X_WINDOW (f),
- FRAME_DISPLAY_INFO (f)->root_window,
-
- /* From-position, to-position. */
- x, y, &x, &y,
-
- /* Child of win. */
- &dummy_window);
+ x_translate_coordinates_to_root (f, x, y, &x, &y);
#ifdef HAVE_GTK3
- /* Use window scaling factor to adjust position for hidpi screens. */
+ /* Use window scaling factor to adjust position for scaled
+ outputs. */
x /= xg_get_scale (f);
y /= xg_get_scale (f);
#endif
@@ -1743,7 +1735,6 @@ create_and_show_popup_menu (struct frame *f, widget_value
*first_wv,
XButtonPressedEvent *event = &(dummy.xbutton);
LWLIB_ID menu_id;
Widget menu;
- Window dummy_window;
#if defined HAVE_XINPUT2 && defined USE_MOTIF
XEvent property_dummy;
Atom property_atom;
@@ -1775,17 +1766,7 @@ create_and_show_popup_menu (struct frame *f,
widget_value *first_wv,
/* Adjust coordinates to be root-window-relative. */
block_input ();
x += FRAME_LEFT_SCROLL_BAR_AREA_WIDTH (f);
- XTranslateCoordinates (FRAME_X_DISPLAY (f),
-
- /* From-window, to-window. */
- FRAME_X_WINDOW (f),
- FRAME_DISPLAY_INFO (f)->root_window,
-
- /* From-position, to-position. */
- x, y, &x, &y,
-
- /* Child of win. */
- &dummy_window);
+ x_translate_coordinates_to_root (f, x, y, &x, &y);
unblock_input ();
event->x_root = x;
@@ -2559,6 +2540,8 @@ pop_down_menu (void *arg)
}
#endif
+ /* Decrement the popup_activated_flag. */
+ popup_activated_flag = 0;
#endif /* HAVE_X_WINDOWS */
unblock_input ();
@@ -2569,9 +2552,6 @@ Lisp_Object
x_menu_show (struct frame *f, int x, int y, int menuflags,
Lisp_Object title, const char **error_name)
{
-#ifdef HAVE_X_WINDOWS
- Window dummy_window;
-#endif
Window root;
XMenu *menu;
int pane, selidx, lpane, status;
@@ -2620,17 +2600,7 @@ x_menu_show (struct frame *f, int x, int y, int
menuflags,
inhibit_garbage_collection ();
#ifdef HAVE_X_WINDOWS
- XTranslateCoordinates (FRAME_X_DISPLAY (f),
-
- /* From-window, to-window. */
- FRAME_X_WINDOW (f),
- FRAME_DISPLAY_INFO (f)->root_window,
-
- /* From-position, to-position. */
- x, y, &x, &y,
-
- /* Child of win. */
- &dummy_window);
+ x_translate_coordinates_to_root (f, x, y, &x, &y);
#else
/* MSDOS without X support. */
x += f->left_pos;
@@ -2782,21 +2752,22 @@ x_menu_show (struct frame *f, int x, int y, int
menuflags,
y += 1.5 * height/ (maxlines + 2);
}
- XMenuSetAEQ (menu, true);
XMenuSetFreeze (menu, true);
pane = selidx = 0;
#ifndef MSDOS
DEFER_SELECTIONS;
- XMenuActivateSetWaitFunction (x_menu_wait_for_event, FRAME_X_DISPLAY (f));
+ XMenuActivateSetWaitFunction (x_menu_wait_for_event,
+ FRAME_X_DISPLAY (f));
+ XMenuEventHandler (x_menu_dispatch_event);
+
/* When the input extension is in use, the owner_events grab will
report extension events on frames, which the XMenu library does
not normally understand. */
#ifdef HAVE_XINPUT2
XMenuActivateSetTranslateFunction (x_menu_translate_generic_event);
#endif
- XMenuActivateSetExposeFunction (x_menu_expose_event);
#endif
record_unwind_protect_ptr (pop_down_menu,
@@ -2822,6 +2793,12 @@ x_menu_show (struct frame *f, int x, int y, int
menuflags,
}
#endif
+#ifdef HAVE_X_WINDOWS
+ /* Increment the popup flag; this prevents nested popups from being
+ displayed by user Lisp code in help-echo callbacks, and also
+ prevents mouse face from being displayed. */
+ popup_activated_flag = 1;
+#endif
status = XMenuActivate (FRAME_X_DISPLAY (f), menu, &pane, &selidx,
x, y, ButtonReleaseMask, &datap,
menu_help_callback);
diff --git a/src/xselect.c b/src/xselect.c
index 66782d4172..a381fa2352 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -918,6 +918,13 @@ x_handle_selection_request (struct selection_input_event
*event)
}
/* Save conversion results */
lisp_data_to_selection_data (dpyinfo, multprop, &cs);
+
+ /* If cs.type is ATOM, change it to ATOM_PAIR. This is because
+ the parameters to a MULTIPLE are ATOM_PAIRs. */
+
+ if (cs.type == XA_ATOM)
+ cs.type = dpyinfo->Xatom_ATOM_PAIR;
+
XChangeProperty (dpyinfo->display, requestor, property,
cs.type, cs.format, PropModeReplace,
cs.data, cs.size);
@@ -960,7 +967,7 @@ x_handle_selection_request (struct selection_input_event
*event)
x_reply_selection_request. If FOR_MULTIPLE, write out
the data even if conversion fails, using conversion_fail_tag.
- Return true iff successful. */
+ Return true if successful. */
static bool
x_convert_selection (Lisp_Object selection_symbol,
@@ -2376,12 +2383,19 @@ On Nextstep, TERMINAL is unused. */)
{
Window owner;
Atom atom;
+#ifdef HAVE_XFIXES
+ Window temp_owner;
+#endif
struct frame *f = frame_for_x_selection (terminal);
struct x_display_info *dpyinfo;
CHECK_SYMBOL (selection);
- if (NILP (selection)) selection = QPRIMARY;
- if (EQ (selection, Qt)) selection = QSECONDARY;
+
+ if (NILP (selection))
+ selection = QPRIMARY;
+
+ if (EQ (selection, Qt))
+ selection = QSECONDARY;
if (!f)
return Qnil;
@@ -2392,10 +2406,22 @@ On Nextstep, TERMINAL is unused. */)
return Qt;
atom = symbol_to_x_atom (dpyinfo, selection);
- if (atom == 0) return Qnil;
+
+ if (!atom)
+ return Qnil;
+
+#ifdef HAVE_XFIXES
+ /* See if this information can be obtained without a roundtrip. */
+ temp_owner = x_find_selection_owner (dpyinfo, atom);
+
+ if (temp_owner != X_INVALID_WINDOW)
+ return (temp_owner != None ? Qt : Qnil);
+#endif
+
block_input ();
owner = XGetSelectionOwner (dpyinfo->display, atom);
unblock_input ();
+
return (owner ? Qt : Qnil);
}
@@ -2768,7 +2794,6 @@ x_handle_dnd_message (struct frame *f, const
XClientMessageEvent *event,
unsigned char *data = (unsigned char *) event->data.b;
int idata[5];
ptrdiff_t i;
- Window child_return;
for (i = 0; i < dpyinfo->x_dnd_atoms_length; ++i)
if (dpyinfo->x_dnd_atoms[i] == event->message_type) break;
@@ -2803,11 +2828,7 @@ x_handle_dnd_message (struct frame *f, const
XClientMessageEvent *event,
if (!root_window_coords)
x_relative_mouse_position (f, &x, &y);
else
- XTranslateCoordinates (dpyinfo->display,
- dpyinfo->root_window,
- FRAME_X_WINDOW (f),
- root_x, root_y,
- &x, &y, &child_return);
+ x_translate_coordinates (f, root_x, root_y, &x, &y);
bufp->kind = DRAG_N_DROP_EVENT;
bufp->frame_or_window = frame;
diff --git a/src/xsettings.c b/src/xsettings.c
index e4a9865d68..00b67539d4 100644
--- a/src/xsettings.c
+++ b/src/xsettings.c
@@ -54,12 +54,15 @@ typedef unsigned int CARD32;
#include <gconf/gconf-client.h>
#endif
-#if defined USE_CAIRO || defined HAVE_XFT
#ifdef USE_CAIRO
#include <fontconfig/fontconfig.h>
-#else /* HAVE_XFT */
+#include "ftfont.h"
+#elif defined HAVE_XFT
#include <X11/Xft/Xft.h>
#endif
+
+#if defined USE_CAIRO && defined CAIRO_HAS_FT_FONT
+#include <cairo/cairo-ft.h>
#endif
static char *current_mono_font;
@@ -763,7 +766,7 @@ parse_settings (unsigned char *prop,
#ifndef HAVE_PGTK
/* Read settings from the XSettings property window on display for DPYINFO.
Store settings read in SETTINGS.
- Return true iff successful. */
+ Return true if successful. */
static bool
read_settings (Display_Info *dpyinfo, struct xsettings *settings)
@@ -804,16 +807,31 @@ static void
apply_xft_settings (Display_Info *dpyinfo,
struct xsettings *settings)
{
-#ifdef HAVE_XFT
+#if defined HAVE_XFT \
+ || (defined USE_CAIRO && defined CAIRO_HAS_FC_FONT \
+ && defined CAIRO_HAS_FT_FONT)
FcPattern *pat;
struct xsettings oldsettings;
bool changed = false;
+#ifndef HAVE_XFT
+ cairo_font_options_t *options;
+#endif
+
memset (&oldsettings, 0, sizeof (oldsettings));
pat = FcPatternCreate ();
+#ifdef HAVE_XFT
XftDefaultSubstitute (dpyinfo->display,
XScreenNumberOfScreen (dpyinfo->screen),
pat);
+#else
+ FcConfigSubstitute (NULL, pat, FcMatchPattern);
+ options = cairo_font_options_create ();
+ ftcrfont_get_default_font_options (dpyinfo, options);
+ cairo_ft_font_options_substitute (options, pat);
+ cairo_font_options_destroy (options);
+ FcDefaultSubstitute (pat);
+#endif
FcPatternGetBool (pat, FC_ANTIALIAS, 0, &oldsettings.aa);
FcPatternGetBool (pat, FC_HINTING, 0, &oldsettings.hinting);
#ifdef FC_HINT_STYLE
@@ -868,6 +886,14 @@ apply_xft_settings (Display_Info *dpyinfo,
}
#endif
+#ifdef USE_CAIRO
+ /* When Cairo is being used, set oldsettings.dpi to dpyinfo->resx.
+ This is a gross hack, but seeing as Cairo fails to report
+ anything reasonable, just use it to avoid config-changed events
+ being sent at startup. */
+ oldsettings.dpi = dpyinfo->resx;
+#endif
+
if ((settings->seen & SEEN_DPI) != 0
&& settings->dpi > 0
/* The following conjunct avoids setting `changed' to true when
@@ -912,8 +938,11 @@ apply_xft_settings (Display_Info *dpyinfo,
- sizeof "%f")
};
char buf[sizeof format + d_formats * d_growth + lf_formats * lf_growth];
-
+#ifdef HAVE_XFT
XftDefaultSet (dpyinfo->display, pat);
+#else
+ FcPatternDestroy (pat);
+#endif
store_config_changed_event (Qfont_render,
XCAR (dpyinfo->name_list_element));
Vxft_settings
@@ -925,7 +954,7 @@ apply_xft_settings (Display_Info *dpyinfo,
}
else
FcPatternDestroy (pat);
-#endif /* HAVE_XFT */
+#endif /* HAVE_XFT || (USE_CAIRO && CAIRO_HAS_FC_FONT && CAIRO_HAS_FT_FONT) */
}
#endif
diff --git a/src/xterm.c b/src/xterm.c
index 1d58e80f00..af652a0d85 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -912,11 +912,6 @@ struct x_selection_request_event
struct x_selection_request_event *pending_selection_requests;
-/* Compare two request serials A and B with OP, handling
- wraparound. */
-#define X_COMPARE_SERIALS(a, op ,b) \
- (((long) (a) - (long) (b)) op 0)
-
struct x_atom_ref
{
/* Atom name. */
@@ -1139,11 +1134,11 @@ static void x_clean_failable_requests (struct
x_display_info *);
static struct frame *x_tooltip_window_to_frame (struct x_display_info *,
Window, bool *);
static Window x_get_window_below (Display *, Window, int, int, int *, int *);
+static void x_set_input_focus (struct x_display_info *, Window, Time);
#ifndef USE_TOOLKIT_SCROLL_BARS
static void x_scroll_bar_redraw (struct scroll_bar *);
#endif
-static void x_translate_coordinates (struct frame *, int, int, int *, int *);
/* Global state maintained during a drag-and-drop operation. */
@@ -1425,9 +1420,6 @@ struct x_client_list_window
/* The width and height of the window. */
int width, height;
- /* Whether or not the window is mapped. */
- bool mapped_p;
-
/* A bitmask describing events Emacs was listening for from the
window before some extra events were added in
`x_dnd_compute_toplevels'. */
@@ -1439,9 +1431,6 @@ struct x_client_list_window
/* The next window in this list. */
struct x_client_list_window *next;
- /* The Motif protocol style of this window, if any. */
- uint8_t xm_protocol_style;
-
/* The extents of the frame window in each direction. */
int frame_extents_left;
int frame_extents_right;
@@ -1452,18 +1441,24 @@ struct x_client_list_window
/* The border width of this window. */
int border_width;
- /* The rectangles making up the input shape. */
- XRectangle *input_rects;
-
/* The number of rectangles composing the input shape. */
int n_input_rects;
+ /* The rectangles making up the input shape. */
+ XRectangle *input_rects;
+
/* The rectangles making up the bounding shape. */
XRectangle *bounding_rects;
/* The number of rectangles composing the bounding shape. */
int n_bounding_rects;
#endif
+
+ /* The Motif protocol style of this window, if any. */
+ uint8_t xm_protocol_style;
+
+ /* Whether or not the window is mapped. */
+ bool mapped_p;
};
/* List of all toplevels in stacking order, from top to bottom. */
@@ -5139,24 +5134,20 @@ x_update_opaque_region (struct frame *f, XEvent
*configure)
if (!FRAME_DISPLAY_INFO (f)->alpha_bits)
return;
- block_input ();
if (f->alpha_background < 1.0)
- XChangeProperty (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region,
XA_CARDINAL, 32, PropModeReplace,
NULL, 0);
#ifndef HAVE_GTK3
else
- XChangeProperty (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region,
XA_CARDINAL, 32, PropModeReplace,
(unsigned char *) &opaque_region, 4);
#else
else if (FRAME_TOOLTIP_P (f))
- XChangeProperty (FRAME_X_DISPLAY (f),
- FRAME_X_WINDOW (f),
+ XChangeProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region,
XA_CARDINAL, 32, PropModeReplace,
(unsigned char *) &opaque_region, 4);
@@ -5174,7 +5165,6 @@ x_update_opaque_region (struct frame *f, XEvent
*configure)
}
}
#endif
- unblock_input ();
}
@@ -5251,7 +5241,9 @@ xi_convert_button_state (XIButtonState *in, unsigned int
*out)
}
}
-/* Return the modifier state in XEV as a standard X modifier mask. */
+/* Return the modifier state in XEV as a standard X modifier mask.
+ This should be used for non-keyboard events, where the group does
+ not matter. */
#ifdef USE_GTK
static
@@ -5269,6 +5261,17 @@ xi_convert_event_state (XIDeviceEvent *xev)
return mods | buttons;
}
+/* Like the above. However, buttons are not converted, while the
+ group is. This should be used for key events being passed to the
+ likes of input methods and Xt. */
+
+static unsigned int
+xi_convert_event_keyboard_state (XIDeviceEvent *xev)
+{
+ return ((xev->mods.effective & ~(1 << 13 | 1 << 14))
+ | (xev->group.effective << 13));
+}
+
/* Free all XI2 devices on DPYINFO. */
static void
x_free_xi_devices (struct x_display_info *dpyinfo)
@@ -5307,6 +5310,7 @@ x_free_xi_devices (struct x_display_info *dpyinfo)
}
#ifdef HAVE_XINPUT2_1
+
struct xi_known_valuator
{
/* The current value of this valuator. */
@@ -5318,20 +5322,60 @@ struct xi_known_valuator
/* The next valuator whose value we already know. */
struct xi_known_valuator *next;
};
+
+/* Populate the scroll valuator at INDEX in DEVICE with the scroll
+ valuator information provided in INFO.
+
+ The information consists of:
+
+ - whether or not the valuator is horizontal.
+
+ - whether or not the valuator's value is currently unknown,
+ until the next XI_Motion event is received or the valuator's
+ value is restored by the caller upon encountering valuator
+ class data.
+
+ - what the current value of the valuator is. This is set to
+ DBL_MIN for debugging purposes, but can be any value, as
+ invalid_p is currently true.
+
+ - the increment, which defines the amount of movement equal to a
+ single unit of scrolling. For example, if the increment is
+ 2.0, then a WHEEL_DOWN or WHEEL_UP event will be sent every
+ time the valuator value changes by 2.0, unless
+ mwheel-coalesce-scroll-events is nil.
+
+ - the number used in XI_Motion events and elsewhere to identify
+ the valuator. */
+
+static void
+xi_populate_scroll_valuator (struct xi_device_t *device,
+ int index, XIScrollClassInfo *info)
+{
+ struct xi_scroll_valuator_t *valuator;
+
+ valuator = &device->valuators[index];
+ valuator->horizontal
+ = (info->scroll_type == XIScrollTypeHorizontal);
+ valuator->invalid_p = true;
+ valuator->emacs_value = DBL_MIN;
+ valuator->increment = info->increment;
+ valuator->number = info->number;
+}
+
#endif
static void
-xi_populate_device_from_info (struct xi_device_t *xi_device,
+xi_populate_device_from_info (struct x_display_info *dpyinfo,
+ struct xi_device_t *xi_device,
XIDeviceInfo *device)
{
#ifdef HAVE_XINPUT2_1
- struct xi_scroll_valuator_t *valuator;
struct xi_known_valuator *values, *tem;
- int actual_valuator_count;
+ int actual_valuator_count, c;
XIScrollClassInfo *info;
- XIValuatorClassInfo *val_info;
+ XIValuatorClassInfo *valuator_info;
#endif
- int c;
#ifdef HAVE_XINPUT2_2
XITouchClassInfo *touch_info;
#endif
@@ -5340,59 +5384,121 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
USE_SAFE_ALLOCA;
#endif
+ /* Initialize generic information about the device: its ID, which
+ buttons are currently pressed and thus presumably actively
+ grabbing the device, what kind of device it is (master pointer,
+ master keyboard, slave pointer, slave keyboard, or floating
+ slave), and its attachment.
+
+ Here is a brief description of what device uses and attachments
+ are. Under XInput 2, user input from individual input devices is
+ multiplexed into specific seats before being delivered, with each
+ seat corresponding to a single on-screen mouse pointer and having
+ its own keyboard focus. Each seat consists of two virtual
+ devices: the master keyboard and the master pointer, the first of
+ which is used to report all keyboard input, with the other used
+ to report all other input.
+
+ Input from each physical device (mouse, trackpad or keyboard) is
+ then associated with that slave device's paired master device.
+ For example, moving the device "Logitech USB Optical Mouse",
+ enslaved by the master pointer device "Virtual core pointer",
+ will result in movement of the mouse pointer associated with that
+ master device's seat. If the pointer moves over an Emacs frame,
+ then the frame will receive XI_Enter and XI_Motion events from
+ that master pointer.
+
+ Likewise, keyboard input from the device "AT Translated Set 2
+ keyboard", enslaved by the master keyboard device "Virtual core
+ keyboard", will be reported to its seat's input focus window.
+
+ The device use describes what the device is. The meanings of
+ MasterPointer, MasterKeyboard, SlavePointer and SlaveKeyboard
+ should be obvious. FloatingSlave means the device is a slave
+ device that is not associated with any seat, and thus generates
+ no input.
+
+ The device attachment is a device ID whose meaning varies
+ depending on the device use. If the device is a master device,
+ then the attachment is the device ID of the other device in its
+ seat (the master keyboard for master pointer devices, and vice
+ versa). Otherwise, it is the ID of the master device the slave
+ device is attached to. For slave devices not attached to any
+ seat, its value is undefined. */
+
xi_device->device_id = device->deviceid;
xi_device->grab = 0;
-
-#ifdef HAVE_XINPUT2_1
- actual_valuator_count = 0;
- xi_device->valuators = xmalloc (sizeof *xi_device->valuators
- * device->num_classes);
- values = NULL;
-#endif
-
xi_device->use = device->use;
xi_device->name = build_string (device->name);
xi_device->attachment = device->attachment;
+ /* Clear the list of active touch points on the device, which are
+ individual touches tracked by a touchscreen. */
+
#ifdef HAVE_XINPUT2_2
xi_device->touchpoints = NULL;
xi_device->direct_p = false;
#endif
+#ifdef HAVE_XINPUT2_1
+ if (!dpyinfo->xi2_version)
+ {
+ /* Skip everything below as there are no classes of interest on
+ XI 2.0 servers. */
+ xi_device->valuators = NULL;
+ xi_device->scroll_valuator_count = 0;
+
+ SAFE_FREE ();
+ return;
+ }
+
+ actual_valuator_count = 0;
+ xi_device->valuators = xnmalloc (device->num_classes,
+ sizeof *xi_device->valuators);
+ values = NULL;
+
+ /* Initialize device info based on a list of "device classes".
+ Device classes are little pieces of information associated with a
+ device. Emacs is interested in scroll valuator information and
+ touch handling information, which respectively describe the axes
+ (if any) along which the device's scroll wheel rotates, and how
+ the device reports touch input. */
+
for (c = 0; c < device->num_classes; ++c)
{
switch (device->classes[c]->type)
{
-#ifdef HAVE_XINPUT2_1
case XIScrollClass:
{
info = (XIScrollClassInfo *) device->classes[c];
-
- valuator = &xi_device->valuators[actual_valuator_count++];
- valuator->horizontal
- = (info->scroll_type == XIScrollTypeHorizontal);
- valuator->invalid_p = true;
- valuator->emacs_value = DBL_MIN;
- valuator->increment = info->increment;
- valuator->number = info->number;
- valuator->pending_enter_reset = false;
-
+ xi_populate_scroll_valuator (xi_device, actual_valuator_count++,
+ info);
break;
}
case XIValuatorClass:
{
- val_info = (XIValuatorClassInfo *) device->classes[c];
+ valuator_info = (XIValuatorClassInfo *) device->classes[c];
tem = SAFE_ALLOCA (sizeof *tem);
+ /* Avoid restoring bogus values if some driver
+ accidentally specifies relative values in scroll
+ valuator classes how the input extension spec says they
+ should be, but allow restoring values when a value is
+ set, which is how the input extension actually
+ behaves. */
+
+ if (valuator_info->value == 0.0
+ && valuator_info->mode != XIModeAbsolute)
+ continue;
+
tem->next = values;
- tem->number = val_info->number;
- tem->current_value = val_info->value;
+ tem->number = valuator_info->number;
+ tem->current_value = valuator_info->value;
values = tem;
break;
}
-#endif
#ifdef HAVE_XINPUT2_2
case XITouchClass:
@@ -5406,7 +5512,6 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
}
}
-#ifdef HAVE_XINPUT2_1
xi_device->scroll_valuator_count = actual_valuator_count;
/* Now look through all the valuators whose values are already known
@@ -5420,8 +5525,9 @@ xi_populate_device_from_info (struct xi_device_t
*xi_device,
if (xi_device->valuators[c].number == tem->number)
{
xi_device->valuators[c].invalid_p = false;
- xi_device->valuators[c].current_value = tem->current_value;
- xi_device->valuators[c].pending_enter_reset = true;
+ xi_device->valuators[c].current_value
+ = tem->current_value;
+ xi_device->valuators[c].emacs_value = 0.0;
}
}
}
@@ -5483,7 +5589,8 @@ x_cache_xi_devices (struct x_display_info *dpyinfo)
for (i = 0; i < ndevices; ++i)
{
if (infos[i].enabled)
- xi_populate_device_from_info (&dpyinfo->devices[actual_devices++],
+ xi_populate_device_from_info (dpyinfo,
+ &dpyinfo->devices[actual_devices++],
&infos[i]);
}
@@ -5615,11 +5722,14 @@ xi_find_touch_point (struct xi_device_t *device, int
detail)
#ifdef HAVE_XINPUT2_1
static void
-xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo, int
id,
- bool pending_only)
+xi_reset_scroll_valuators_for_device_id (struct x_display_info *dpyinfo,
+ int id)
{
- struct xi_device_t *device = xi_device_from_id (dpyinfo, id);
+ struct xi_device_t *device;
struct xi_scroll_valuator_t *valuator;
+ int i;
+
+ device = xi_device_from_id (dpyinfo, id);
if (!device)
return;
@@ -5627,14 +5737,9 @@ xi_reset_scroll_valuators_for_device_id (struct
x_display_info *dpyinfo, int id,
if (!device->scroll_valuator_count)
return;
- for (int i = 0; i < device->scroll_valuator_count; ++i)
+ for (i = 0; i < device->scroll_valuator_count; ++i)
{
valuator = &device->valuators[i];
-
- if (pending_only && !valuator->pending_enter_reset)
- continue;
-
- valuator->pending_enter_reset = false;
valuator->invalid_p = true;
valuator->emacs_value = 0.0;
}
@@ -7049,6 +7154,13 @@ x_update_begin (struct frame *f)
#else
/* Nothing to do. */
#endif
+
+#ifdef HAVE_XDBE
+ if (FRAME_X_DOUBLE_BUFFERED_P (f))
+ /* The frame is no longer complete, as it is in the midst of an
+ update. */
+ FRAME_X_COMPLETE_P (f) = false;
+#endif
}
/* Draw a vertical window border from (x,y0) to (x,y1) */
@@ -7144,8 +7256,6 @@ show_back_buffer (struct frame *f)
cairo_t *cr;
#endif
- block_input ();
-
if (FRAME_X_DOUBLE_BUFFERED_P (f))
{
#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME
@@ -7174,8 +7284,6 @@ show_back_buffer (struct frame *f)
}
FRAME_X_NEED_BUFFER_FLIP (f) = false;
-
- unblock_input ();
}
#endif
@@ -7199,6 +7307,10 @@ x_flip_and_flush (struct frame *f)
#ifdef HAVE_XDBE
if (FRAME_X_NEED_BUFFER_FLIP (f))
show_back_buffer (f);
+
+ /* The frame is complete again as its contents were just
+ flushed. */
+ FRAME_X_COMPLETE_P (f) = true;
#endif
x_flush (f);
unblock_input ();
@@ -7249,6 +7361,9 @@ XTframe_up_to_date (struct frame *f)
if (!buffer_flipping_blocked_p ()
&& FRAME_X_NEED_BUFFER_FLIP (f))
show_back_buffer (f);
+
+ /* The frame is now complete, as its contents have been drawn. */
+ FRAME_X_COMPLETE_P (f) = true;
#endif
#ifdef HAVE_XSYNC
@@ -7283,8 +7398,12 @@ XTframe_up_to_date (struct frame *f)
static void
XTbuffer_flipping_unblocked_hook (struct frame *f)
{
+ block_input ();
+
if (FRAME_X_NEED_BUFFER_FLIP (f))
show_back_buffer (f);
+
+ unblock_input ();
}
#endif
@@ -7313,8 +7432,6 @@ x_clear_under_internal_border (struct frame *f)
: INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
- block_input ();
-
if (face)
{
unsigned long color = face->background;
@@ -7335,8 +7452,6 @@ x_clear_under_internal_border (struct frame *f)
x_clear_area (f, width - border, 0, border, height);
x_clear_area (f, 0, height - border, width, border);
}
-
- unblock_input ();
}
}
@@ -7384,7 +7499,6 @@ x_after_update_window_line (struct window *w, struct
glyph_row *desired_row)
: INTERNAL_BORDER_FACE_ID));
struct face *face = FACE_FROM_ID_OR_NULL (f, face_id);
- block_input ();
if (face)
{
unsigned long color = face->background;
@@ -7402,7 +7516,6 @@ x_after_update_window_line (struct window *w, struct
glyph_row *desired_row)
x_clear_area (f, 0, y, width, height);
x_clear_area (f, FRAME_PIXEL_WIDTH (f) - width, y, width, height);
}
- unblock_input ();
}
}
#endif
@@ -7601,11 +7714,27 @@ static void x_check_font (struct frame *, struct font
*);
user time. We don't sanitize timestamps from events sent by the X
server itself because some Lisp might have set the user time to a
ridiculously large value, and this way a more reasonable timestamp
- can be obtained upon the next event. */
+ can be obtained upon the next event.
+
+ Alternatively, the server time could've overflowed.
+
+ SET_PROPERTY specifies whether or not to change the user time
+ property for the active frame. The important thing is to not set
+ the last user time upon leave events; on Metacity and GNOME Shell,
+ mapping a new frame on top of the old frame potentially causes
+ crossing events to be sent to the old frame if it contains the
+ pointer, as the new frame will initially stack above the old frame.
+ If _NET_WM_USER_TIME is changed at that point, then GNOME may get
+ notified about the user time change on the old frame before it
+ tries to focus the new frame, which will make it consider the new
+ frame (whose user time property will not have been updated at that
+ point, due to not being focused) as having been mapped
+ out-of-order, and lower the new frame, which is typically not what
+ users want. */
static void
x_display_set_last_user_time (struct x_display_info *dpyinfo, Time time,
- bool send_event)
+ bool send_event, bool set_property)
{
#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME
uint_fast64_t monotonic_time;
@@ -7678,7 +7807,8 @@ x_display_set_last_user_time (struct x_display_info
*dpyinfo, Time time,
#ifndef USE_GTK
/* Don't waste bandwidth if the time hasn't actually changed. */
- if (focus_frame && old_time != dpyinfo->last_user_time)
+ if (focus_frame && old_time != dpyinfo->last_user_time
+ && set_property)
{
time = dpyinfo->last_user_time;
@@ -7715,16 +7845,38 @@ x_set_gtk_user_time (struct frame *f, Time time)
#endif
+#if !defined USE_GTK || defined HAVE_XFIXES
+
+/* Create and return a special window for receiving events such as
+ selection notify events, and reporting user time. The window is an
+ 1x1 unmapped override-redirect InputOnly window at -1, -1 relative
+ to the parent, which should prevent it from doing anything. */
+
+static Window
+x_create_special_window (struct x_display_info *dpyinfo,
+ Window parent_window)
+{
+ XSetWindowAttributes attrs;
+
+ attrs.override_redirect = True;
+
+ return XCreateWindow (dpyinfo->display, parent_window,
+ -1, -1, 1, 1, 0, CopyFromParent, InputOnly,
+ CopyFromParent, CWOverrideRedirect, &attrs);
+}
+
+#endif
+
/* Not needed on GTK because GTK handles reporting the user time
itself. */
#ifndef USE_GTK
+
static void
x_update_frame_user_time_window (struct frame *f)
{
struct x_output *output;
struct x_display_info *dpyinfo;
- XSetWindowAttributes attrs;
output = FRAME_X_OUTPUT (f);
dpyinfo = FRAME_DISPLAY_INFO (f);
@@ -7766,12 +7918,16 @@ x_update_frame_user_time_window (struct frame *f)
if (output->user_time_window == FRAME_OUTER_WINDOW (f)
|| output->user_time_window == None)
{
- memset (&attrs, 0, sizeof attrs);
+ /* Create a "user time" window that is used to report user
+ activity on a given frame. This is used in preference to
+ _NET_WM_USER_TIME, as using a separate window allows the
+ window manager to express interest in other properties
+ while only reading the user time when necessary, thereby
+ improving battery life by not involving the window
+ manager in each key press. */
output->user_time_window
- = XCreateWindow (dpyinfo->display, FRAME_X_WINDOW (f),
- -1, -1, 1, 1, 0, 0, InputOnly,
- CopyFromParent, 0, &attrs);
+ = x_create_special_window (dpyinfo, FRAME_X_WINDOW (f));
XDeleteProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f),
dpyinfo->Xatom_net_wm_user_time);
@@ -7782,13 +7938,14 @@ x_update_frame_user_time_window (struct frame *f)
}
}
}
+
#endif
void
x_set_last_user_time_from_lisp (struct x_display_info *dpyinfo,
Time time)
{
- x_display_set_last_user_time (dpyinfo, time, true);
+ x_display_set_last_user_time (dpyinfo, time, true, true);
}
@@ -9595,31 +9752,49 @@ x_draw_glyph_string_box (struct glyph_string *s)
#ifndef USE_CAIRO
+
static void
x_composite_image (struct glyph_string *s, Pixmap dest,
+#ifdef HAVE_XRENDER
+ Picture destination,
+#endif
int srcX, int srcY, int dstX, int dstY,
int width, int height)
{
- Display *display = FRAME_X_DISPLAY (s->f);
+ Display *display;
#ifdef HAVE_XRENDER
- if (s->img->picture && FRAME_X_PICTURE_FORMAT (s->f))
- {
- Picture destination;
- XRenderPictFormat *default_format;
- XRenderPictureAttributes attr UNINIT;
+ XRenderPictFormat *default_format;
+ XRenderPictureAttributes attr UNINIT;
+#endif
- default_format = FRAME_X_PICTURE_FORMAT (s->f);
- destination = XRenderCreatePicture (display, dest,
- default_format, 0, &attr);
+ display = FRAME_X_DISPLAY (s->f);
- XRenderComposite (display, s->img->mask_picture ? PictOpOver : PictOpSrc,
- s->img->picture, s->img->mask_picture, destination,
- srcX, srcY,
- srcX, srcY,
- dstX, dstY,
- width, height);
+#ifdef HAVE_XRENDER
+ if (s->img->picture && FRAME_X_PICTURE_FORMAT (s->f))
+ {
+ if (destination == None)
+ {
+ /* The destination picture was not specified. This means we
+ have to create a picture representing the */
+ default_format = FRAME_X_PICTURE_FORMAT (s->f);
+ destination = XRenderCreatePicture (display, dest,
+ default_format, 0, &attr);
+
+ XRenderComposite (display, (s->img->mask_picture
+ ? PictOpOver : PictOpSrc),
+ s->img->picture, s->img->mask_picture,
+ destination, srcX, srcY, srcX, srcY,
+ dstX, dstY, width, height);
+
+ XRenderFreePicture (display, destination);
+ }
+ else
+ XRenderComposite (display, (s->img->mask_picture
+ ? PictOpOver : PictOpSrc),
+ s->img->picture, s->img->mask_picture,
+ destination, srcX, srcY, srcX, srcY,
+ dstX, dstY, width, height);
- XRenderFreePicture (display, destination);
return;
}
#endif
@@ -9629,6 +9804,7 @@ x_composite_image (struct glyph_string *s, Pixmap dest,
srcX, srcY,
width, height, dstX, dstY);
}
+
#endif /* !USE_CAIRO */
@@ -9707,6 +9883,9 @@ x_draw_image_foreground (struct glyph_string *s)
image_rect.height = s->slice.height;
if (gui_intersect_rectangles (&clip_rect, &image_rect, &r))
x_composite_image (s, FRAME_X_DRAWABLE (s->f),
+#ifdef HAVE_XRENDER
+ FRAME_X_PICTURE (s->f),
+#endif
s->slice.x + r.x - x, s->slice.y + r.y - y,
r.x, r.y, r.width, r.height);
}
@@ -9720,7 +9899,12 @@ x_draw_image_foreground (struct glyph_string *s)
image_rect.width = s->slice.width;
image_rect.height = s->slice.height;
if (gui_intersect_rectangles (&clip_rect, &image_rect, &r))
- x_composite_image (s, FRAME_X_DRAWABLE (s->f), s->slice.x + r.x -
x, s->slice.y + r.y - y,
+ x_composite_image (s, FRAME_X_DRAWABLE (s->f),
+#ifdef HAVE_XRENDER
+ FRAME_X_PICTURE (s->f),
+#endif
+ s->slice.x + r.x - x,
+ s->slice.y + r.y - y,
r.x, r.y, r.width, r.height);
/* When the image has a mask, we can expect that at
@@ -9886,8 +10070,11 @@ x_draw_image_foreground_1 (struct glyph_string *s,
Pixmap pixmap)
XChangeGC (display, s->gc, mask, &xgcv);
x_composite_image (s, pixmap,
- s->slice.x, s->slice.y,
- x, y, s->slice.width, s->slice.height);
+#ifdef HAVE_XRENDER
+ None,
+#endif
+ s->slice.x, s->slice.y, x, y,
+ s->slice.width, s->slice.height);
XSetClipMask (display, s->gc, None);
}
else
@@ -10768,6 +10955,7 @@ x_clear_frame (struct frame *f)
/* We have to clear the scroll bars. If we have changed colors or
something like that, then they should be notified. */
x_scroll_bar_clear (f);
+
unblock_input ();
}
@@ -10781,6 +10969,16 @@ x_show_hourglass (struct frame *f)
if (dpy)
{
struct x_output *x = FRAME_X_OUTPUT (f);
+
+ /* If the hourglass window is mapped inside a popup menu, input
+ could be lost if the menu is popped down and the grab is
+ relinquished, but the hourglass window is still up. Just
+ avoid displaying the hourglass at all while popups are
+ active. */
+
+ if (popup_activated ())
+ return;
+
#ifdef USE_X_TOOLKIT
if (x->widget)
#else
@@ -10819,7 +11017,7 @@ x_show_hourglass (struct frame *f)
(xcb_window_t) x->hourglass_window,
parent, 0, 0, FRAME_PIXEL_WIDTH (f),
FRAME_PIXEL_HEIGHT (f), 0,
- XCB_WINDOW_CLASS_INPUT_OUTPUT,
+ XCB_WINDOW_CLASS_INPUT_ONLY,
XCB_COPY_FROM_PARENT, XCB_CW_CURSOR,
&cursor);
#endif
@@ -11334,15 +11532,18 @@ x_new_focus_frame (struct x_display_info *dpyinfo,
struct frame *frame)
x_frame_rehighlight (dpyinfo);
}
+#ifdef HAVE_XFIXES
+
/* True if the display in DPYINFO supports a version of Xfixes
sufficient for pointer blanking. */
-#ifdef HAVE_XFIXES
+
static bool
-x_probe_xfixes_extension (struct x_display_info *dpyinfo)
+x_fixes_pointer_blanking_supported (struct x_display_info *dpyinfo)
{
return (dpyinfo->xfixes_supported_p
&& dpyinfo->xfixes_major >= 4);
}
+
#endif /* HAVE_XFIXES */
/* Toggle mouse pointer visibility on frame F using the XFixes
@@ -11413,7 +11614,7 @@ x_toggle_visible_pointer (struct frame *f, bool
invisible)
/* But if Xfixes is available, try using it instead. */
if (dpyinfo->invisible_cursor == None)
{
- if (x_probe_xfixes_extension (dpyinfo))
+ if (x_fixes_pointer_blanking_supported (dpyinfo))
{
dpyinfo->fixes_pointer_blanking = true;
xfixes_toggle_visible_pointer (f, invisible);
@@ -11441,7 +11642,7 @@ XTtoggle_invisible_pointer (struct frame *f, bool
invisible)
block_input ();
#ifdef HAVE_XFIXES
if (FRAME_DISPLAY_INFO (f)->fixes_pointer_blanking
- && x_probe_xfixes_extension (FRAME_DISPLAY_INFO (f)))
+ && x_fixes_pointer_blanking_supported (FRAME_DISPLAY_INFO (f)))
xfixes_toggle_visible_pointer (f, invisible);
else
#endif
@@ -11449,13 +11650,16 @@ XTtoggle_invisible_pointer (struct frame *f, bool
invisible)
unblock_input ();
}
-/* Handle FocusIn and FocusOut state changes for FRAME.
- If FRAME has focus and there exists more than one frame, puts
- a FOCUS_IN_EVENT into *BUFP. */
+/* Handle FocusIn and FocusOut state changes for FRAME. If FRAME has
+ focus and there exists more than one frame, puts a FOCUS_IN_EVENT
+ into *BUFP. Note that this code is not used to handle focus
+ changes on builds that can use the X Input extension for handling
+ input focus when it is available (currently the no toolkit and GTK
+ 3 toolkits). */
static void
-x_focus_changed (int type, int state, struct x_display_info *dpyinfo, struct
frame *frame,
- struct input_event *bufp)
+x_focus_changed (int type, int state, struct x_display_info *dpyinfo,
+ struct frame *frame, struct input_event *bufp)
{
if (type == FocusIn)
{
@@ -12758,11 +12962,21 @@ xi_focus_handle_for_device (struct x_display_info
*dpyinfo,
switch (event->evtype)
{
case XI_FocusIn:
+ /* The last-focus-change time of the device changed, so update the
+ frame's user time. */
+ x_display_set_last_user_time (dpyinfo, event->time,
+ event->send_event, true);
+
device->focus_frame = mentioned_frame;
device->focus_frame_time = event->time;
break;
case XI_FocusOut:
+ /* The last-focus-change time of the device changed, so update the
+ frame's user time. */
+ x_display_set_last_user_time (dpyinfo, event->time,
+ event->send_event, false);
+
device->focus_frame = NULL;
/* So, unfortunately, the X Input Extension is implemented such
@@ -12927,129 +13141,181 @@ xi_get_scroll_valuator (struct xi_device_t *device,
int number)
return NULL;
}
-#endif
+/* Check if EVENT, a DeviceChanged event, contains any scroll
+ valuators. */
-/* Handle EVENT, a DeviceChanged event. Look up the device that
- changed, and update its information with the data in EVENT. */
+static bool
+xi_has_scroll_valuators (XIDeviceChangedEvent *event)
+{
+ int i;
+
+ for (i = 0; i < event->num_classes; ++i)
+ {
+ if (event->classes[i]->type == XIScrollClass)
+ return true;
+ }
+
+ return false;
+}
+
+/* Repopulate the information (touchpoint tracking information, scroll
+ valuators, etc) in DEVICE with the device classes provided in
+ CLASSES. This is called upon receiving a DeviceChanged event.
+
+ This function is not present on XI 2.0 as there are no worthwhile
+ classes there. */
static void
-xi_handle_device_changed (struct x_display_info *dpyinfo,
- struct xi_device_t *device,
- XIDeviceChangedEvent *event)
+xi_handle_new_classes (struct x_display_info *dpyinfo, struct xi_device_t
*device,
+ XIAnyClassInfo **classes, int num_classes)
{
-#ifdef HAVE_XINPUT2_1
- XIDeviceInfo *info;
XIScrollClassInfo *scroll;
- int i, ndevices;
struct xi_scroll_valuator_t *valuator;
XIValuatorClassInfo *valuator_info;
-#endif
+ int i;
#ifdef HAVE_XINPUT2_2
- struct xi_touch_point_t *tem, *last;
XITouchClassInfo *touch;
#endif
-#ifdef HAVE_XINPUT2_1
- /* When a DeviceChange event is received for a master device, we
- don't get any scroll valuators along with it. This is possibly
- an X server bug but I really don't want to dig any further, so
- fetch the scroll valuators manually. (bug#57020) */
-
- x_catch_errors (dpyinfo->display);
- info = XIQueryDevice (dpyinfo->display, event->deviceid,
- /* ndevices is always 1 if a deviceid is
- specified. If the request fails, NULL will
- be returned. */
- &ndevices);
- x_uncatch_errors ();
+ if (dpyinfo->xi2_version < 1)
+ /* Emacs is connected to an XI 2.0 server, which reports no
+ classes of interest. */
+ return;
- if (info)
- {
- device->valuators = xrealloc (device->valuators,
- (info->num_classes
- * sizeof *device->valuators));
- device->scroll_valuator_count = 0;
+ device->valuators = xnmalloc (num_classes,
+ sizeof *device->valuators);
+ device->scroll_valuator_count = 0;
#ifdef HAVE_XINPUT2_2
- device->direct_p = false;
+ device->direct_p = false;
#endif
- for (i = 0; i < info->num_classes; ++i)
+ for (i = 0; i < num_classes; ++i)
+ {
+ switch (classes[i]->type)
{
- switch (info->classes[i]->type)
- {
- case XIScrollClass:
- scroll = (XIScrollClassInfo *) info->classes[i];
-
- valuator = &device->valuators[device->scroll_valuator_count++];
- valuator->horizontal = (scroll->scroll_type
- == XIScrollTypeHorizontal);
- valuator->invalid_p = true;
- valuator->emacs_value = DBL_MIN;
- valuator->increment = scroll->increment;
- valuator->number = scroll->number;
- break;
+ case XIScrollClass:
+ scroll = (XIScrollClassInfo *) classes[i];
+
+ xi_populate_scroll_valuator (device,
+ device->scroll_valuator_count++,
+ scroll);
+ break;
#ifdef HAVE_XINPUT2_2
- case XITouchClass:
- touch = (XITouchClassInfo *) info->classes[i];
+ case XITouchClass:
+ touch = (XITouchClassInfo *) classes[i];
- if (touch->mode == XIDirectTouch)
- device->direct_p = true;
- break;
+ if (touch->mode == XIDirectTouch)
+ device->direct_p = true;
+ break;
#endif
- }
}
+ }
- /* Restore the values of any scroll valuators that we already
- know about. */
+ /* Restore the values of any scroll valuators that we already
+ know about. */
- for (i = 0; i < info->num_classes; ++i)
- {
- switch (info->classes[i]->type)
- {
- case XIValuatorClass:
- valuator_info = (XIValuatorClassInfo *) info->classes[i];
+ for (i = 0; i < num_classes; ++i)
+ {
+ if (classes[i]->type != XIValuatorClass)
+ continue;
- valuator = xi_get_scroll_valuator (device,
- valuator_info->number);
- if (valuator)
- {
- valuator->invalid_p = false;
- valuator->current_value = valuator_info->value;
+ valuator_info = (XIValuatorClassInfo *) classes[i];
- /* Make sure that this is reset if the pointer moves
- into a window of ours.
+ /* Avoid restoring bogus values if some driver accidentally
+ specifies relative values in scroll valuator classes how the
+ input extension spec says they should be, but allow restoring
+ values when a value is set, which is how the input extension
+ actually behaves. */
- Otherwise the valuator state could be left
- invalid if the DeviceChange event happened with
- the pointer outside any Emacs frame. */
- valuator->pending_enter_reset = true;
- }
+ if (valuator_info->value == 0.0
+ && valuator_info->mode != XIModeAbsolute)
+ continue;
- break;
- }
- }
+ valuator = xi_get_scroll_valuator (device,
+ valuator_info->number);
+
+ if (!valuator)
+ continue;
+
+ valuator->invalid_p = false;
+ valuator->current_value = valuator_info->value;
+ valuator->emacs_value = 0;
+
+ break;
+ }
+}
+
+#endif
+
+/* Handle EVENT, a DeviceChanged event. Look up the device that
+ changed, and update its information with the data in EVENT. */
+static void
+xi_handle_device_changed (struct x_display_info *dpyinfo,
+ struct xi_device_t *device,
+ XIDeviceChangedEvent *event)
+{
+#ifdef HAVE_XINPUT2_1
+ int ndevices;
+ XIDeviceInfo *info;
+#endif
#ifdef HAVE_XINPUT2_2
- /* The device is no longer a DirectTouch device, so
- remove any touchpoints that we might have
- recorded. */
- if (!device->direct_p)
- {
- tem = device->touchpoints;
+ struct xi_touch_point_t *tem, *last;
+#endif
- while (tem)
- {
- last = tem;
- tem = tem->next;
- xfree (last);
- }
+#ifdef HAVE_XINPUT2_1
+ if (xi_has_scroll_valuators (event))
+ /* Scroll valuators are provided by this event. Use the values
+ provided in this event to populate the device's new scroll
+ valuator list: if this event is a SlaveSwitch event caused by
+ wheel movement, then querying for the device info will probably
+ return the value after the wheel movement, leading to a delta
+ of 0 being computed upon handling the subsequent XI_Motion
+ event. (bug#58980) */
+ xi_handle_new_classes (dpyinfo, device, event->classes,
+ event->num_classes);
+ else
+ {
+ /* When a DeviceChange event is received for a master device,
+ the X server sometimes does not send any scroll valuators
+ along with it. This is possibly an X server bug but I really
+ don't want to dig any further, so fetch the scroll valuators
+ manually. (bug#57020) */
- device->touchpoints = NULL;
- }
+ x_catch_errors (dpyinfo->display);
+ info = XIQueryDevice (dpyinfo->display, event->deviceid,
+ /* ndevices is always 1 if a deviceid is
+ specified. If the request fails, NULL will
+ be returned. */
+ &ndevices);
+ x_uncatch_errors ();
+
+ if (!info)
+ return;
+
+ /* info contains the classes currently associated with the
+ event. Apply them. */
+ xi_handle_new_classes (dpyinfo, device, info->classes,
+ info->num_classes);
+ }
#endif
- XIFreeDeviceInfo (info);
+#ifdef HAVE_XINPUT2_2
+ /* The device is no longer a DirectTouch device, so remove any
+ touchpoints that we might have recorded. */
+ if (!device->direct_p)
+ {
+ tem = device->touchpoints;
+
+ while (tem)
+ {
+ last = tem;
+ tem = tem->next;
+ xfree (last);
+ }
+
+ device->touchpoints = NULL;
}
#endif
}
@@ -13301,7 +13567,7 @@ x_find_modifier_meanings (struct x_display_info
*dpyinfo)
#ifdef HAVE_XKB
int i;
int found_meta_p = false;
- uint vmodmask;
+ unsigned int vmodmask;
#endif
dpyinfo->meta_mod_mask = 0;
@@ -13560,7 +13826,7 @@ x_compute_root_window_offset (struct frame *f, int
root_x, int root_y,
many cases while handling events, which would otherwise result in
slowdowns over slow network connections. */
-static void
+void
x_translate_coordinates (struct frame *f, int root_x, int root_y,
int *x_out, int *y_out)
{
@@ -13596,19 +13862,81 @@ x_translate_coordinates (struct frame *f, int root_x,
int root_y,
}
}
-/* The same, but for an XIDeviceEvent. */
-
-#ifdef HAVE_XINPUT2
+/* Translate the given coordinates from the edit window of FRAME,
+ taking into account any cached root window offsets. This is mainly
+ used from the popup menu code. */
-static void
-xi_compute_root_window_offset (struct frame *f, XIDeviceEvent *xev)
+void
+x_translate_coordinates_to_root (struct frame *f, int x, int y,
+ int *x_out, int *y_out)
{
- /* Truncate coordinates instead of rounding them, because that is
- how the X server handles window hierarchy. */
- x_compute_root_window_offset (f, xev->root_x, xev->root_y,
- xev->event_x, xev->event_y);
-}
-
+ struct x_output *output;
+ Window dummy;
+
+ output = FRAME_X_OUTPUT (f);
+
+ if (output->window_offset_certain_p)
+ {
+ /* Use the cached root window offset. */
+ *x_out = x + output->root_x;
+ *y_out = y + output->root_y;
+
+ return;
+ }
+
+ /* Otherwise, do the transform manually and compute and cache the
+ root window position. */
+ if (!XTranslateCoordinates (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f),
+ FRAME_DISPLAY_INFO (f)->root_window,
+ x, y, x_out, y_out, &dummy))
+ *x_out = 0, *y_out = 0;
+ else
+ {
+ /* Cache the root window offset of the edit window. */
+ output->window_offset_certain_p = true;
+ output->root_x = *x_out - x;
+ output->root_y = *y_out - y;
+ }
+}
+
+/* Do x-translate-coordinates, but try to avoid a roundtrip to the X
+ server at the cost of not returning `child', which most callers
+ have no reason to use. */
+
+Lisp_Object
+x_handle_translate_coordinates (struct frame *f, Lisp_Object dest_window,
+ int source_x, int source_y)
+{
+ if (NILP (dest_window))
+ {
+ /* We are translating coordinates from a frame to the root
+ window. Avoid a roundtrip if possible by using cached
+ coordinates. */
+
+ if (!FRAME_X_OUTPUT (f)->window_offset_certain_p)
+ return Qnil;
+
+ return list3 (make_fixnum (source_x + FRAME_X_OUTPUT (f)->root_x),
+ make_fixnum (source_y + FRAME_X_OUTPUT (f)->root_y),
+ Qnil);
+ }
+
+ return Qnil;
+}
+
+/* The same, but for an XIDeviceEvent. */
+
+#ifdef HAVE_XINPUT2
+
+static void
+xi_compute_root_window_offset (struct frame *f, XIDeviceEvent *xev)
+{
+ /* Truncate coordinates instead of rounding them, because that is
+ how the X server handles window hierarchy. */
+ x_compute_root_window_offset (f, xev->root_x, xev->root_y,
+ xev->event_x, xev->event_y);
+}
+
static void
xi_compute_root_window_offset_enter (struct frame *f, XIEnterEvent *enter)
{
@@ -13935,6 +14263,136 @@ x_get_window_below (Display *dpy, Window window,
return value;
}
+/* Like XTmouse_position, but much faster. */
+
+static void
+x_fast_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window,
+ enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object
*y,
+ Time *timestamp)
+{
+ int root_x, root_y, win_x, win_y;
+ unsigned int mask;
+ Window dummy;
+ struct scroll_bar *bar;
+ struct x_display_info *dpyinfo;
+ Lisp_Object tail, frame;
+ struct frame *f1;
+
+ dpyinfo = FRAME_DISPLAY_INFO (*fp);
+
+ if (dpyinfo->last_mouse_scroll_bar && !insist)
+ {
+ bar = dpyinfo->last_mouse_scroll_bar;
+
+ if (bar->horizontal)
+ x_horizontal_scroll_bar_report_motion (fp, bar_window, part,
+ x, y, timestamp);
+ else
+ x_scroll_bar_report_motion (fp, bar_window, part,
+ x, y, timestamp);
+
+ return;
+ }
+
+ if (!EQ (Vx_use_fast_mouse_position, Qreally_fast))
+ {
+ /* This means that Emacs should select a frame and report the
+ mouse position relative to it. The approach used here avoids
+ making multiple roundtrips to the X server querying for the
+ window beneath the pointer, and was borrowed from
+ haiku_mouse_position in haikuterm.c. */
+
+ FOR_EACH_FRAME (tail, frame)
+ {
+ if (FRAME_X_P (XFRAME (frame))
+ && (FRAME_DISPLAY_INFO (XFRAME (frame))
+ == dpyinfo))
+ XFRAME (frame)->mouse_moved = false;
+ }
+
+ if (gui_mouse_grabbed (dpyinfo)
+ && !EQ (track_mouse, Qdropping)
+ && !EQ (track_mouse, Qdrag_source))
+ /* Pick the last mouse frame if dropping. */
+ f1 = dpyinfo->last_mouse_frame;
+ else
+ /* Otherwise, pick the last mouse motion frame. */
+ f1 = dpyinfo->last_mouse_motion_frame;
+
+ if (!f1 && (FRAME_X_P (SELECTED_FRAME ())
+ && (FRAME_DISPLAY_INFO (SELECTED_FRAME ())
+ == dpyinfo)))
+ f1 = SELECTED_FRAME ();
+
+ if (!f1 || (!FRAME_X_P (f1) && (insist > 0)))
+ FOR_EACH_FRAME (tail, frame)
+ if (FRAME_X_P (XFRAME (frame))
+ && (FRAME_DISPLAY_INFO (XFRAME (frame))
+ == dpyinfo)
+ && !FRAME_TOOLTIP_P (XFRAME (frame)))
+ f1 = XFRAME (frame);
+
+ if (f1 && FRAME_TOOLTIP_P (f1))
+ f1 = NULL;
+
+ if (f1 && FRAME_X_P (f1) && FRAME_X_WINDOW (f1))
+ {
+ if (!x_query_pointer (dpyinfo->display, FRAME_X_WINDOW (f1),
+ &dummy, &dummy, &root_x, &root_y,
+ &win_x, &win_y, &mask))
+ /* The pointer is out of the screen. */
+ return;
+
+ remember_mouse_glyph (f1, win_x, win_y,
+ &dpyinfo->last_mouse_glyph);
+ dpyinfo->last_mouse_glyph_frame = f1;
+
+ *bar_window = Qnil;
+ *part = scroll_bar_nowhere;
+
+ /* If track-mouse is `drag-source' and the mouse pointer is
+ certain to not be actually under the chosen frame, return
+ NULL in FP. */
+ if (EQ (track_mouse, Qdrag_source)
+ && (win_x < 0 || win_y < 0
+ || win_x >= FRAME_PIXEL_WIDTH (f1)
+ || win_y >= FRAME_PIXEL_HEIGHT (f1)))
+ *fp = NULL;
+ else
+ *fp = f1;
+
+ *timestamp = dpyinfo->last_mouse_movement_time;
+ XSETINT (*x, win_x);
+ XSETINT (*y, win_y);
+ }
+ }
+ else
+ {
+ /* This means Emacs should only report the coordinates of the
+ last mouse motion. */
+
+ if (dpyinfo->last_mouse_motion_frame)
+ {
+ *fp = dpyinfo->last_mouse_motion_frame;
+ *timestamp = dpyinfo->last_mouse_movement_time;
+ *x = make_fixnum (dpyinfo->last_mouse_motion_x);
+ *y = make_fixnum (dpyinfo->last_mouse_motion_y);
+ *bar_window = Qnil;
+ *part = scroll_bar_nowhere;
+
+ FOR_EACH_FRAME (tail, frame)
+ {
+ if (FRAME_X_P (XFRAME (frame))
+ && (FRAME_DISPLAY_INFO (XFRAME (frame))
+ == dpyinfo))
+ XFRAME (frame)->mouse_moved = false;
+ }
+
+ dpyinfo->last_mouse_motion_frame->mouse_moved = false;
+ }
+ }
+}
+
/* Return the current position of the mouse.
*FP should be a frame which indicates which display to ask about.
@@ -13961,9 +14419,27 @@ XTmouse_position (struct frame **fp, int insist,
Lisp_Object *bar_window,
Time *timestamp)
{
struct frame *f1, *maybe_tooltip;
- struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (*fp);
+ struct x_display_info *dpyinfo;
bool unrelated_tooltip;
+ dpyinfo = FRAME_DISPLAY_INFO (*fp);
+
+ if (!NILP (Vx_use_fast_mouse_position))
+ {
+ /* The user says that Emacs is running over the network, and a
+ fast approximation of `mouse-position' should be used.
+
+ Depending on what the value of `x-use-fast-mouse-position'
+ is, do one of two things: only perform the XQueryPointer to
+ obtain the coordinates from the last mouse frame, or only
+ return the last mouse motion frame and the
+ last_mouse_motion_x and Y. */
+
+ x_fast_mouse_position (fp, insist, bar_window, part, x,
+ y, timestamp);
+ return;
+ }
+
block_input ();
if (dpyinfo->last_mouse_scroll_bar && insist == 0)
@@ -14085,7 +14561,7 @@ XTmouse_position (struct frame **fp, int insist,
Lisp_Object *bar_window,
break;
}
#ifdef USE_GTK
- /* We don't wan't to know the innermost window. We
+ /* We don't want to know the innermost window. We
want the edit window. For non-Gtk+ the innermost
window is the edit window. For Gtk+ it might not
be. It might be the tool bar for example. */
@@ -14116,7 +14592,7 @@ XTmouse_position (struct frame **fp, int insist,
Lisp_Object *bar_window,
never use them in that case.) */
#ifdef USE_GTK
- /* We don't wan't to know the innermost window. We
+ /* We don't want to know the innermost window. We
want the edit window. */
f1 = x_window_to_frame (dpyinfo, win);
#else
@@ -14143,7 +14619,8 @@ XTmouse_position (struct frame **fp, int insist,
Lisp_Object *bar_window,
< dpyinfo->last_mouse_movement_time))
x_display_set_last_user_time (dpyinfo,
dpyinfo->last_mouse_movement_time,
-
dpyinfo->last_mouse_movement_time_send_event);
+
dpyinfo->last_mouse_movement_time_send_event,
+ true);
if ((!f1 || FRAME_TOOLTIP_P (f1))
&& (EQ (track_mouse, Qdropping)
@@ -14759,7 +15236,8 @@ xg_scroll_callback (GtkRange *range, GtkScrollType
scroll,
dpyinfo = FRAME_DISPLAY_INFO (f);
if (time != GDK_CURRENT_TIME)
- x_display_set_last_user_time (dpyinfo, time, true);
+ x_display_set_last_user_time (dpyinfo, time, true,
+ true);
switch (scroll)
{
@@ -16983,18 +17461,21 @@ x_net_wm_state (struct frame *f, Window window)
/* Flip back buffers on F if it has undrawn content. */
-#ifdef HAVE_XDBE
static void
-flush_dirty_back_buffer_on (struct frame *f)
+x_flush_dirty_back_buffer_on (struct frame *f)
{
- block_input ();
- if (!FRAME_GARBAGED_P (f)
- && !buffer_flipping_blocked_p ()
- && FRAME_X_NEED_BUFFER_FLIP (f))
- show_back_buffer (f);
- unblock_input ();
-}
+#ifdef HAVE_XDBE
+ if (FRAME_GARBAGED_P (f)
+ || buffer_flipping_blocked_p ()
+ /* If the frame is not already up to date, do not flush buffers
+ on input, as that will result in flicker. */
+ || !FRAME_X_COMPLETE_P (f)
+ || !FRAME_X_NEED_BUFFER_FLIP (f))
+ return;
+
+ show_back_buffer (f);
#endif
+}
#ifdef HAVE_GTK3
void
@@ -17704,6 +18185,7 @@ x_coords_from_dnd_message (struct x_display_info
*dpyinfo,
static void
x_handle_wm_state (struct frame *f, struct input_event *ie)
{
+ struct x_display_info *dpyinfo;
Atom type;
int format;
unsigned long nitems, bytes_after;
@@ -17711,10 +18193,11 @@ x_handle_wm_state (struct frame *f, struct
input_event *ie)
unsigned long *state;
data = NULL;
+ dpyinfo = FRAME_DISPLAY_INFO (f);
if (XGetWindowProperty (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- FRAME_DISPLAY_INFO (f)->Xatom_wm_state, 0, 2,
- False, AnyPropertyType, &type, &format, &nitems,
+ dpyinfo->Xatom_wm_state, 0, 2, False,
+ AnyPropertyType, &type, &format, &nitems,
&bytes_after, &data) != Success)
return;
@@ -17739,6 +18222,20 @@ x_handle_wm_state (struct frame *f, struct input_event
*ie)
ie->kind = DEICONIFY_EVENT;
XSETFRAME (ie->frame_or_window, f);
}
+ else if (state[0] == IconicState
+ /* _NET_WM_STATE_HIDDEN should be used if the window
+ manager supports that. */
+ && !x_wm_supports (f, dpyinfo->Xatom_net_wm_state_hidden))
+ {
+ /* The frame is actually iconified right now. Mark it as
+ such. */
+
+ SET_FRAME_VISIBLE (f, 0);
+ SET_FRAME_ICONIFIED (f, true);
+
+ ie->kind = ICONIFY_EVENT;
+ XSETFRAME (ie->frame_or_window, f);
+ }
/* state[0] can also be WithdrawnState, meaning that the window has
been withdrawn and is no longer iconified. However, Emacs sets
@@ -17748,6 +18245,46 @@ x_handle_wm_state (struct frame *f, struct input_event
*ie)
XFree (data);
}
+#ifdef HAVE_XFIXES
+
+static bool
+x_handle_selection_monitor_event (struct x_display_info *dpyinfo,
+ const XEvent *event)
+{
+ XFixesSelectionNotifyEvent *notify;
+ int i;
+
+ notify = (XFixesSelectionNotifyEvent *) event;
+
+ if (notify->window != dpyinfo->selection_tracking_window)
+ return false;
+
+ for (i = 0; i < dpyinfo->n_monitored_selections; ++i)
+ {
+ /* We don't have to keep track of timestamps here. */
+ if (notify->selection == dpyinfo->monitored_selections[i].name)
+ dpyinfo->monitored_selections[i].owner = notify->owner;
+ }
+
+ return true;
+}
+
+Window
+x_find_selection_owner (struct x_display_info *dpyinfo, Atom selection)
+{
+ int i;
+
+ for (i = 0; i < dpyinfo->n_monitored_selections; ++i)
+ {
+ if (selection == dpyinfo->monitored_selections[i].name)
+ return dpyinfo->monitored_selections[i].owner;
+ }
+
+ return X_INVALID_WINDOW;
+}
+
+#endif
+
/* Handles the XEvent EVENT on display DPYINFO.
*FINISH is X_EVENT_GOTO_OUT if caller should stop reading events.
@@ -17774,7 +18311,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
Time gen_help_time UNINIT;
#endif
ptrdiff_t nbytes = 0;
- struct frame *any, *f = NULL;
+ struct frame *any, *f = NULL, *mouse_frame;
Mouse_HLInfo *hlinfo = &dpyinfo->mouse_highlight;
/* This holds the state XLookupString needs to implement dead keys
and other tricks known as "compose processing". _X Window System_
@@ -17795,7 +18332,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
GdkDisplay *gdpy = gdk_x11_lookup_xdisplay (dpyinfo->display);
#endif
int dx, dy;
+
+ /* Avoid warnings when SAFE_ALLOCA is not actually used. */
+#if defined HAVE_XINPUT2 || defined HAVE_XKB || defined HAVE_X_I18N
USE_SAFE_ALLOCA;
+#endif
/* This function is not reentrant, so input should be blocked before
it is called. */
@@ -18077,6 +18618,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
/* Not certain about handling scroll bars here */
#endif
+ /* Set the provided time as the user time, which is
+ required for SetInputFocus to work correctly after
+ taking the input focus. */
+ x_display_set_last_user_time (dpyinfo, event->xclient.data.l[1],
+ true, true);
goto done;
}
@@ -18406,7 +18952,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
/* If drag-and-drop or another modal dialog/menu is in
progress, handle SelectionRequest events immediately, by
- pushing it onto the selecction queue. */
+ pushing it onto the selection queue. */
if (x_use_pending_selection_requests)
{
@@ -18704,8 +19250,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
x_real_positions (f, &f->left_pos, &f->top_pos);
/* Perhaps reparented due to a WM restart. Reset this. */
- FRAME_DISPLAY_INFO (f)->wm_type = X_WMTYPE_UNKNOWN;
- FRAME_DISPLAY_INFO (f)->net_supported_window = 0;
+ dpyinfo->wm_type = X_WMTYPE_UNKNOWN;
+ dpyinfo->net_supported_window = 0;
#ifndef USE_GTK
/* The window manager could have restarted and the new
@@ -18733,11 +19279,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
goto OTHER;
case Expose:
- f = x_window_to_frame (dpyinfo, event->xexpose.window);
+
#ifdef HAVE_XWIDGETS
{
- struct xwidget_view *xv =
- xwidget_view_from_window (event->xexpose.window);
+ struct xwidget_view *xv;
+
+ xv = xwidget_view_from_window (event->xexpose.window);
if (xv)
{
@@ -18746,6 +19293,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
}
#endif
+
+ f = x_window_to_frame (dpyinfo, event->xexpose.window);
if (f)
{
if (!FRAME_VISIBLE_P (f))
@@ -19064,7 +19613,8 @@ handle_one_xevent (struct x_display_info *dpyinfo,
case KeyPress:
x_display_set_last_user_time (dpyinfo, event->xkey.time,
- event->xkey.send_event);
+ event->xkey.send_event,
+ true);
ignore_next_mouse_click_timeout = 0;
coding = Qlatin_1;
@@ -19092,9 +19642,14 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| !EQ (f->tab_bar_window, hlinfo->mouse_face_window))
)
{
- clear_mouse_face (hlinfo);
- hlinfo->mouse_face_hidden = true;
- }
+ mouse_frame = hlinfo->mouse_face_mouse_frame;
+
+ clear_mouse_face (hlinfo);
+ hlinfo->mouse_face_hidden = true;
+
+ if (mouse_frame)
+ x_flush_dirty_back_buffer_on (mouse_frame);
+ }
#if defined USE_MOTIF && defined USE_TOOLKIT_SCROLL_BARS
if (f == 0)
@@ -19168,7 +19723,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
*finish = X_EVENT_DROP;
#endif
- xkey.state |= x_emacs_to_x_modifiers (FRAME_DISPLAY_INFO (f),
+ xkey.state |= x_emacs_to_x_modifiers (dpyinfo,
extra_keyboard_modifiers);
modifiers = xkey.state;
@@ -19285,7 +19840,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
/* Common for all keysym input events. */
XSETFRAME (inev.ie.frame_or_window, f);
inev.ie.modifiers
- = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers);
+ = x_x_to_emacs_modifiers (dpyinfo, modifiers);
inev.ie.timestamp = xkey.time;
/* First deal with keysyms which have defined
@@ -19543,28 +20098,16 @@ handle_one_xevent (struct x_display_info *dpyinfo,
case EnterNotify:
x_display_set_last_user_time (dpyinfo, event->xcrossing.time,
- event->xcrossing.send_event);
-
-#ifdef HAVE_XINPUT2
- /* For whatever reason, the X server continues to deliver
- EnterNotify and LeaveNotify events despite us selecting for
- related XI_Enter and XI_Leave events. It's not just our
- problem, since windows created by "xinput test-xi2" suffer
- from the same defect. Simply ignore all such events while
- the input extension is enabled. (bug#57468) */
-
- if (dpyinfo->supports_xi2)
- goto OTHER;
-#endif
-
- if (x_top_window_to_frame (dpyinfo, event->xcrossing.window))
- x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+ event->xcrossing.send_event,
+ false);
#ifdef HAVE_XWIDGETS
{
- struct xwidget_view *xvw = xwidget_view_from_window
(event->xcrossing.window);
+ struct xwidget_view *xvw;
Mouse_HLInfo *hlinfo;
+ xvw = xwidget_view_from_window (event->xcrossing.window);
+
if (xvw)
{
xwidget_motion_or_crossing (xvw, event);
@@ -19574,17 +20117,32 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
clear_mouse_face (hlinfo);
hlinfo->mouse_face_mouse_frame = 0;
+ x_flush_dirty_back_buffer_on (xvw->frame);
}
if (any_help_event_p)
- {
- do_help = -1;
- }
+ do_help = -1;
+
goto OTHER;
}
}
#endif
+#ifdef HAVE_XINPUT2
+ /* For whatever reason, the X server continues to deliver
+ EnterNotify and LeaveNotify events despite us selecting for
+ related XI_Enter and XI_Leave events. It's not just our
+ problem, since windows created by "xinput test-xi2" suffer
+ from the same defect. Simply ignore all such events while
+ the input extension is enabled. (bug#57468) */
+
+ if (dpyinfo->supports_xi2)
+ goto OTHER;
+#endif
+
+ if (x_top_window_to_frame (dpyinfo, event->xcrossing.window))
+ x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+
f = any;
if (f && event->xcrossing.window == FRAME_X_WINDOW (f))
@@ -19666,7 +20224,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
case LeaveNotify:
x_display_set_last_user_time (dpyinfo, event->xcrossing.time,
- event->xcrossing.send_event);
+ event->xcrossing.send_event, false);
#ifdef HAVE_XINPUT2
/* For whatever reason, the X server continues to deliver
@@ -19677,12 +20235,27 @@ handle_one_xevent (struct x_display_info *dpyinfo,
the input extension is enabled. (bug#57468) */
if (dpyinfo->supports_xi2)
- goto OTHER;
+ {
+#if !defined USE_X_TOOLKIT && (!defined USE_GTK || defined HAVE_GTK3)
+ goto OTHER;
+#else
+ /* Unfortunately, X toolkit popups generate LeaveNotify
+ events due to the core grabs they acquire (and our
+ releasing of the device grab). This leads to the mouse
+ face persisting if a popup is activated by clicking on a
+ button, and then dismissed by releasing the mouse button
+ outside the frame, in which case no XI_Enter event is
+ generated for the grab. */
+ goto just_clear_mouse_face;
+#endif
+ }
#endif
#ifdef HAVE_XWIDGETS
{
- struct xwidget_view *xvw = xwidget_view_from_window
(event->xcrossing.window);
+ struct xwidget_view *xvw;
+
+ xvw = xwidget_view_from_window (event->xcrossing.window);
if (xvw)
{
@@ -19695,6 +20268,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (x_top_window_to_frame (dpyinfo, event->xcrossing.window))
x_detect_focus_change (dpyinfo, any, event, &inev.ie);
+#if defined HAVE_XINPUT2 \
+ && (defined USE_X_TOOLKIT || (defined USE_GTK && !defined HAVE_GTK3))
+ just_clear_mouse_face:
+#endif
+
#if defined USE_X_TOOLKIT
/* If the mouse leaves the edit widget, then any mouse highlight
should be cleared. */
@@ -19727,6 +20305,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
certainly no longer on any text in the frame. */
clear_mouse_face (hlinfo);
hlinfo->mouse_face_mouse_frame = 0;
+ x_flush_dirty_back_buffer_on (f);
}
/* Generate a nil HELP_EVENT to cancel a help-echo.
@@ -19784,7 +20363,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
help_echo_string = Qnil;
if (hlinfo->mouse_face_hidden)
- {
+ {
hlinfo->mouse_face_hidden = false;
clear_mouse_face (hlinfo);
}
@@ -20036,7 +20615,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
f = 0;
#endif
#ifdef HAVE_XWIDGETS
- struct xwidget_view *xvw = xwidget_view_from_window
(event->xmotion.window);
+ struct xwidget_view *xvw;
+
+ xvw = xwidget_view_from_window (event->xmotion.window);
if (xvw)
xwidget_motion_or_crossing (xvw, event);
@@ -20115,6 +20696,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (!NILP (help_echo_string)
|| !NILP (previous_help_echo_string))
do_help = 1;
+
+ if (f)
+ x_flush_dirty_back_buffer_on (f);
goto OTHER;
}
@@ -20411,7 +20995,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
int old_left = f->left_pos;
int old_top = f->top_pos;
- Lisp_Object frame = Qnil;
+ Lisp_Object frame;
XSETFRAME (frame, f);
@@ -20481,10 +21065,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
{
if (event->xbutton.type == ButtonPress)
x_display_set_last_user_time (dpyinfo, event->xbutton.time,
- event->xbutton.send_event);
+ event->xbutton.send_event, true);
#ifdef HAVE_XWIDGETS
- struct xwidget_view *xvw = xwidget_view_from_window
(event->xbutton.window);
+ struct xwidget_view *xvw;
+
+ xvw = xwidget_view_from_window (event->xbutton.window);
if (xvw)
{
@@ -20533,7 +21119,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (event->type == ButtonPress)
{
x_display_set_last_user_time (dpyinfo, event->xbutton.time,
- event->xbutton.send_event);
+ event->xbutton.send_event, true);
dpyinfo->grabbed |= (1 << event->xbutton.button);
dpyinfo->last_mouse_frame = f;
@@ -20608,7 +21194,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
event->xbutton.time);
}
else if (x_dnd_last_seen_window != None
- && x_dnd_last_protocol_version != -1)
+ && x_dnd_last_protocol_version != -1)
{
x_dnd_pending_finish_target = x_dnd_last_seen_toplevel;
x_dnd_waiting_for_finish_proto =
x_dnd_last_protocol_version;
@@ -20726,8 +21312,11 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (FRAME_PARENT_FRAME (f) || (hf && frame_ancestor_p (f, hf)))
{
+ x_ignore_errors_for_next_request (dpyinfo);
XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
RevertToParent, event->xbutton.time);
+ x_stop_ignoring_errors (dpyinfo);
+
if (FRAME_PARENT_FRAME (f))
XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
}
@@ -20781,9 +21370,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
tab_bar_p = EQ (window, f->tab_bar_window);
if (tab_bar_p)
- tab_bar_arg = handle_tab_bar_click
- (f, x, y, event->xbutton.type == ButtonPress,
- x_x_to_emacs_modifiers (dpyinfo, event->xbutton.state));
+ {
+ tab_bar_arg = handle_tab_bar_click
+ (f, x, y, event->xbutton.type == ButtonPress,
+ x_x_to_emacs_modifiers (dpyinfo, event->xbutton.state));
+ x_flush_dirty_back_buffer_on (f);
+ }
}
#if ! defined (USE_GTK)
@@ -20801,9 +21393,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| f->last_tool_bar_item != -1));
if (tool_bar_p && event->xbutton.button < 4)
- handle_tool_bar_click
- (f, x, y, event->xbutton.type == ButtonPress,
- x_x_to_emacs_modifiers (dpyinfo, event->xbutton.state));
+ {
+ handle_tool_bar_click
+ (f, x, y, event->xbutton.type == ButtonPress,
+ x_x_to_emacs_modifiers (dpyinfo, event->xbutton.state));
+ x_flush_dirty_back_buffer_on (f);
+ }
}
#endif /* !USE_GTK */
@@ -21090,7 +21685,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
ev.send_event = enter->send_event;
x_display_set_last_user_time (dpyinfo, enter->time,
- enter->send_event);
+ enter->send_event, false);
#ifdef USE_MOTIF
use_copy = true;
@@ -21133,20 +21728,21 @@ handle_one_xevent (struct x_display_info *dpyinfo,
related to those grabs arrive. The only way to
remedy this is to never reset scroll valuators on a
grab-related crossing event. (bug#57476) */
+
if (enter->mode != XINotifyUngrab
&& enter->mode != XINotifyGrab
&& enter->mode != XINotifyPassiveGrab
&& enter->mode != XINotifyPassiveUngrab)
- xi_reset_scroll_valuators_for_device_id (dpyinfo,
enter->deviceid,
- true);
+ xi_reset_scroll_valuators_for_device_id (dpyinfo,
+ enter->deviceid);
#endif
{
#ifdef HAVE_XWIDGETS
- struct xwidget_view *xwidget_view = xwidget_view_from_window
(enter->event);
-#endif
+ struct xwidget_view *xwidget_view;
+
+ xwidget_view = xwidget_view_from_window (enter->event);
-#ifdef HAVE_XWIDGETS
if (xwidget_view)
{
xwidget_motion_or_crossing (xwidget_view, event);
@@ -21251,37 +21847,42 @@ handle_one_xevent (struct x_display_info *dpyinfo,
retrieve the value of a valuator outside of each motion
event.
- As such, to prevent wildly inaccurate results when the
- valuators have changed outside Emacs, we reset our
- records of each valuator's value whenever the pointer
- moves out of a frame (and not into one of its
- children, which we know about). */
+ As such, to prevent wildly inaccurate results when
+ the valuators have changed outside Emacs, we reset
+ our records of each valuator's value whenever the
+ pointer moves out of a frame. Ideally, this would
+ ignore events with a detail of XINotifyInferior, as
+ the window the pointer moved to would be one known to
+ Emacs, but the code to keep track of which valuators
+ had to be reset upon the corresponding XI_Enter event
+ was very complicated and kept running into server
+ bugs. */
#ifdef HAVE_XINPUT2_1
- if (leave->detail != XINotifyInferior && any
- /* xfwm4 selects for button events on the frame
- window, resulting in passive grabs being
- generated along with the delivery of emulated
- button events; this then interferes with
- scrolling, since device valuators will constantly
- be reset as the crossing events related to those
- grabs arrive. The only way to remedy this is to
- never reset scroll valuators on a grab-related
- crossing event. (bug#57476) */
- && leave->mode != XINotifyUngrab
+ /* xfwm4 selects for button events on the frame window,
+ resulting in passive grabs being generated along with
+ the delivery of emulated button events; this then
+ interferes with scrolling, since device valuators
+ will constantly be reset as the crossing events
+ related to those grabs arrive. The only way to
+ remedy this is to never reset scroll valuators on a
+ grab-related crossing event. (bug#57476) */
+
+ if (leave->mode != XINotifyUngrab
&& leave->mode != XINotifyGrab
&& leave->mode != XINotifyPassiveUngrab
&& leave->mode != XINotifyPassiveGrab)
xi_reset_scroll_valuators_for_device_id (dpyinfo,
- leave->deviceid,
false);
+ leave->deviceid);
#endif
x_display_set_last_user_time (dpyinfo, leave->time,
- leave->send_event);
+ leave->send_event, false);
#ifdef HAVE_XWIDGETS
{
- struct xwidget_view *xvw
- = xwidget_view_from_window (leave->event);
+ struct xwidget_view *xvw;
+
+ xvw = xwidget_view_from_window (leave->event);
if (xvw)
{
@@ -21303,20 +21904,6 @@ handle_one_xevent (struct x_display_info *dpyinfo,
masks are set on the frame widget's window. */
f = x_window_to_frame (dpyinfo, leave->event);
- /* Also do this again here, since the test for `any'
- above may not have found a frame, as that usually
- just looks up a top window on Xt builds. */
-
-#ifdef HAVE_XINPUT2_1
- if (leave->detail != XINotifyInferior && f
- && leave->mode != XINotifyUngrab
- && leave->mode != XINotifyGrab
- && leave->mode != XINotifyPassiveUngrab
- && leave->mode != XINotifyPassiveGrab)
- xi_reset_scroll_valuators_for_device_id (dpyinfo,
- leave->deviceid,
false);
-#endif
-
if (!f)
f = x_top_window_to_frame (dpyinfo, leave->event);
#endif
@@ -21342,6 +21929,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
certainly no longer on any text in the frame. */
clear_mouse_face (hlinfo);
hlinfo->mouse_face_mouse_frame = 0;
+ x_flush_dirty_back_buffer_on (f);
}
/* Generate a nil HELP_EVENT to cancel a help-echo.
@@ -21551,7 +22139,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
state = xi_convert_event_state (xev);
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
if (found_valuator)
xwidget_scroll (xv, xev->event_x, xev->event_y,
@@ -21571,7 +22159,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (found_valuator)
{
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
#if defined USE_GTK && !defined HAVE_GTK3
@@ -22017,6 +22605,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
do_help = 1;
}
+
+ if (f)
+ x_flush_dirty_back_buffer_on (f);
goto XI_OTHER;
}
@@ -22062,7 +22653,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (xev->evtype == XI_ButtonPress)
{
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
dpyinfo->grabbed |= (1 << xev->detail);
dpyinfo->last_mouse_frame = f;
@@ -22105,7 +22696,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (xev->flags & XIPointerEmulated)
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event,
true);
#endif
x_dnd_note_self_wheel (dpyinfo,
x_dnd_last_seen_window,
@@ -22341,7 +22932,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (xev->evtype == XI_ButtonPress)
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
source = xi_device_from_id (dpyinfo, xev->sourceid);
device = xi_device_from_id (dpyinfo, xev->deviceid);
@@ -22427,9 +23018,13 @@ handle_one_xevent (struct x_display_info *dpyinfo,
}
#else
/* Non-no toolkit builds without GTK 3 use core
- events to handle focus. */
+ events to handle focus. Errors are still
+ caught here in case the window is not
+ viewable. */
+ x_ignore_errors_for_next_request (dpyinfo);
XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW
(f),
RevertToParent, xev->time);
+ x_stop_ignoring_errors (dpyinfo);
#endif
if (FRAME_PARENT_FRAME (f))
XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW
(f));
@@ -22536,9 +23131,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
tab_bar_p = EQ (window, f->tab_bar_window);
if (tab_bar_p)
- tab_bar_arg = handle_tab_bar_click
- (f, x, y, xev->evtype == XI_ButtonPress,
- x_x_to_emacs_modifiers (dpyinfo, bv.state));
+ {
+ tab_bar_arg = handle_tab_bar_click
+ (f, x, y, xev->evtype == XI_ButtonPress,
+ x_x_to_emacs_modifiers (dpyinfo, bv.state));
+ x_flush_dirty_back_buffer_on (f);
+ }
}
#if ! defined (USE_GTK)
@@ -22563,10 +23161,13 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| f->last_tool_bar_item != -1));
if (tool_bar_p && xev->detail < 4)
- handle_tool_bar_click_with_device
- (f, x, y, xev->evtype == XI_ButtonPress,
- x_x_to_emacs_modifiers (dpyinfo, bv.state),
- source ? source->name : Qt);
+ {
+ handle_tool_bar_click_with_device
+ (f, x, y, xev->evtype == XI_ButtonPress,
+ x_x_to_emacs_modifiers (dpyinfo, bv.state),
+ source ? source->name : Qt);
+ x_flush_dirty_back_buffer_on (f);
+ }
}
#endif /* !USE_GTK */
@@ -22678,7 +23279,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
char *copy_bufptr = copy_buffer;
int copy_bufsiz = sizeof (copy_buffer);
ptrdiff_t i;
- uint old_state;
+ unsigned int old_state;
struct xi_device_t *device, *source;
coding = Qlatin_1;
@@ -22704,8 +23305,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
copy.xkey.root = xev->root;
copy.xkey.subwindow = xev->child;
copy.xkey.time = xev->time;
- copy.xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 <<
14))
- | (xev->group.effective << 13));
+ copy.xkey.state = xi_convert_event_keyboard_state (xev);
xi_convert_button_state (&xev->buttons, ©.xkey.state);
copy.xkey.x = lrint (xev->event_x);
@@ -22720,7 +23320,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#endif
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
ignore_next_mouse_click_timeout = 0;
f = x_any_window_to_frame (dpyinfo, xev->event);
@@ -22761,8 +23361,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
xkey.root = xev->root;
xkey.subwindow = xev->child;
xkey.time = xev->time;
- xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14))
- | (xev->group.effective << 13));
+ xkey.state = xi_convert_event_keyboard_state (xev);
xkey.x = lrint (xev->event_x);
xkey.y = lrint (xev->event_y);
@@ -22826,8 +23425,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
#ifdef HAVE_XKB
if (dpyinfo->xkb_desc)
{
- uint xkb_state = state;
- xkb_state &= ~(1 << 13 | 1 << 14);
+ unsigned int xkb_state;
+
+ xkb_state = state & ~(1 << 13 | 1 << 14);
xkb_state |= xev->group.effective << 13;
if (!XkbTranslateKeyCode (dpyinfo->xkb_desc, keycode,
@@ -22863,8 +23463,13 @@ handle_one_xevent (struct x_display_info *dpyinfo,
|| !EQ (f->tab_bar_window, hlinfo->mouse_face_window))
)
{
+ mouse_frame = hlinfo->mouse_face_mouse_frame;
+
clear_mouse_face (hlinfo);
hlinfo->mouse_face_hidden = true;
+
+ if (mouse_frame)
+ x_flush_dirty_back_buffer_on (mouse_frame);
}
if (f != 0)
@@ -23175,8 +23780,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
xkey.root = xev->root;
xkey.subwindow = xev->child;
xkey.time = xev->time;
- xkey.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14))
- | (xev->group.effective << 13));
+ xkey.state = xi_convert_event_keyboard_state (xev);
xkey.x = lrint (xev->event_x);
xkey.y = lrint (xev->event_y);
xkey.x_root = lrint (xev->root_x);
@@ -23243,7 +23847,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
/* Handle all disabled devices now, to prevent
things happening out-of-order later. */
- if (ndevices)
+ if (n_disabled)
{
xi_disable_devices (dpyinfo, disabled, n_disabled);
n_disabled = 0;
@@ -23278,7 +23882,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
memset (dpyinfo->devices + dpyinfo->num_devices -
1,
0, sizeof *dpyinfo->devices);
device = &dpyinfo->devices[dpyinfo->num_devices -
1];
- xi_populate_device_from_info (device, info);
+ xi_populate_device_from_info (dpyinfo, device,
info);
}
if (info)
@@ -23359,7 +23963,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
device = xi_device_from_id (dpyinfo, xev->deviceid);
source = xi_device_from_id (dpyinfo, xev->sourceid);
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
if (!device)
goto XI_OTHER;
@@ -23457,7 +24061,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
device = xi_device_from_id (dpyinfo, xev->deviceid);
source = xi_device_from_id (dpyinfo, xev->sourceid);
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
if (!device)
goto XI_OTHER;
@@ -23504,7 +24108,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
device = xi_device_from_id (dpyinfo, xev->deviceid);
source = xi_device_from_id (dpyinfo, xev->sourceid);
x_display_set_last_user_time (dpyinfo, xev->time,
- xev->send_event);
+ xev->send_event, true);
if (!device)
goto XI_OTHER;
@@ -23545,7 +24149,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
device = xi_device_from_id (dpyinfo, pev->deviceid);
source = xi_device_from_id (dpyinfo, pev->sourceid);
x_display_set_last_user_time (dpyinfo, pev->time,
- pev->send_event);
+ pev->send_event, true);
if (!device)
goto XI_OTHER;
@@ -23569,8 +24173,9 @@ handle_one_xevent (struct x_display_info *dpyinfo,
xi_compute_root_window_offset_pinch (any, pev);
inev.ie.kind = PINCH_EVENT;
- inev.ie.modifiers = x_x_to_emacs_modifiers
(FRAME_DISPLAY_INFO (any),
-
pev->mods.effective);
+ inev.ie.modifiers
+ = x_x_to_emacs_modifiers (dpyinfo, pev->mods.effective);
+
XSETINT (inev.ie.x, lrint (pev->event_x));
XSETINT (inev.ie.y, lrint (pev->event_y));
XSETFRAME (inev.ie.frame_or_window, any);
@@ -23648,12 +24253,12 @@ handle_one_xevent (struct x_display_info *dpyinfo,
| XkbModifierMapMask
| XkbVirtualModsMask),
dpyinfo->xkb_desc) == Success)
- XkbGetNames (dpyinfo->display,
- XkbGroupNamesMask | XkbVirtualModNamesMask,
+ XkbGetNames (dpyinfo->display, XkbAllNamesMask,
dpyinfo->xkb_desc);
else
{
- XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask,
True);
+ XkbFreeKeyboard (dpyinfo->xkb_desc,
+ XkbAllComponentsMask, True);
dpyinfo->xkb_desc = NULL;
}
}
@@ -23667,8 +24272,7 @@ handle_one_xevent (struct x_display_info *dpyinfo,
XkbUseCoreKbd);
if (dpyinfo->xkb_desc)
- XkbGetNames (dpyinfo->display,
- XkbGroupNamesMask | XkbVirtualModNamesMask,
+ XkbGetNames (dpyinfo->display, XkbAllNamesMask,
dpyinfo->xkb_desc);
}
@@ -23958,6 +24562,17 @@ handle_one_xevent (struct x_display_info *dpyinfo,
if (inev.ie.kind != NO_EVENT)
x_dnd_update_tooltip_now ();
}
+#endif
+#ifdef HAVE_XFIXES
+ if (dpyinfo->xfixes_supported_p
+ && event->type == (dpyinfo->xfixes_event_base
+ + XFixesSelectionNotify)
+ && x_handle_selection_monitor_event (dpyinfo, event))
+ /* GTK 3 crashes if an XFixesSelectionNotify arrives with a
+ window other than the root window, because it wants to know
+ the screen in order to determine the compositing manager
+ selection name. (bug#58584) */
+ *finish = X_EVENT_DROP;
#endif
OTHER:
#ifdef USE_X_TOOLKIT
@@ -24028,19 +24643,10 @@ handle_one_xevent (struct x_display_info *dpyinfo,
count++;
}
- /* Sometimes event processing draws to either F or ANY outside
- redisplay. To ensure that these changes become visible, draw
- them here. */
-
-#ifdef HAVE_XDBE
- if (f)
- flush_dirty_back_buffer_on (f);
-
- if (any && any != f)
- flush_dirty_back_buffer_on (any);
+#if defined HAVE_XINPUT2 || defined HAVE_XKB || defined HAVE_X_I18N
+ SAFE_FREE ();
#endif
- SAFE_FREE ();
return count;
}
@@ -24063,7 +24669,12 @@ x_dispatch_event (XEvent *event, Display *display)
dpyinfo = x_display_info_for_display (display);
if (dpyinfo)
- handle_one_xevent (dpyinfo, event, &finish, 0);
+ {
+ /* Block input before calling x_dispatch_event. */
+ block_input ();
+ handle_one_xevent (dpyinfo, event, &finish, 0);
+ unblock_input ();
+ }
return finish;
}
@@ -24652,6 +25263,48 @@ static struct x_error_message_stack *x_error_message;
/* The amount of items (depth) in that stack. */
int x_error_message_count;
+/* Compare various request serials while handling wraparound. Treat a
+ difference of more than X_ULONG_MAX / 2 as wraparound.
+
+ Note that these functions truncate serials to 32 bits before
+ comparison. */
+
+static bool
+x_is_serial_more_than (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ return true;
+
+ return (b - a > X_ULONG_MAX / 2);
+}
+
+static bool
+x_is_serial_more_than_or_equal_to (unsigned int a, unsigned int b)
+{
+ if (a >= b)
+ return true;
+
+ return (b - a > X_ULONG_MAX / 2);
+}
+
+static bool
+x_is_serial_less_than (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ return true;
+
+ return (a - b > X_ULONG_MAX / 2);
+}
+
+static bool
+x_is_serial_less_than_or_equal_to (unsigned int a, unsigned int b)
+{
+ if (a <= b)
+ return true;
+
+ return (a - b > X_ULONG_MAX / 2);
+}
+
static struct x_error_message_stack *
x_find_error_handler (Display *dpy, XErrorEvent *event)
{
@@ -24661,8 +25314,8 @@ x_find_error_handler (Display *dpy, XErrorEvent *event)
while (stack)
{
- if (X_COMPARE_SERIALS (event->serial, >=,
- stack->first_request)
+ if (x_is_serial_more_than_or_equal_to (event->serial,
+ stack->first_request)
&& dpy == stack->dpy)
return stack;
@@ -24765,11 +25418,11 @@ x_request_can_fail (struct x_display_info *dpyinfo,
failable_requests < dpyinfo->next_failable_request;
failable_requests++)
{
- if (X_COMPARE_SERIALS (request, >=,
- failable_requests->start)
+ if (x_is_serial_more_than_or_equal_to (request,
+ failable_requests->start)
&& (!failable_requests->end
- || X_COMPARE_SERIALS (request, <=,
- failable_requests->end)))
+ || x_is_serial_less_than_or_equal_to (request,
+ failable_requests->end)))
return failable_requests;
}
@@ -24787,11 +25440,11 @@ x_clean_failable_requests (struct x_display_info
*dpyinfo)
for (first = dpyinfo->failable_requests; first < last; first++)
{
- if (X_COMPARE_SERIALS (first->start, >,
- LastKnownRequestProcessed (dpyinfo->display))
+ if (x_is_serial_more_than (first->start,
+ LastKnownRequestProcessed (dpyinfo->display))
|| !first->end
- || X_COMPARE_SERIALS (first->end, >,
- LastKnownRequestProcessed (dpyinfo->display)))
+ || x_is_serial_more_than (first->end,
+ LastKnownRequestProcessed
(dpyinfo->display)))
break;
}
@@ -24870,8 +25523,7 @@ x_stop_ignoring_errors (struct x_display_info *dpyinfo)
/* Abort if no request was made since
`x_ignore_errors_for_next_request'. */
- if (X_COMPARE_SERIALS (range->end, <,
- range->start))
+ if (x_is_serial_less_than (range->end, range->start))
emacs_abort ();
#ifdef HAVE_GTK3
@@ -25511,6 +26163,47 @@ x_new_font (struct frame *f, Lisp_Object font_object,
int fontset)
#ifdef HAVE_X11R6
+/* HAVE_X11R6 means Xlib conforms to the R6 specification or later.
+ HAVE_X11R6_XIM, OTOH, means that Emacs should try to use R6-style
+ callback driven input method initialization. They are separate
+ because Sun apparently ships buggy Xlib with some versions of
+ Solaris... */
+
+#ifdef HAVE_X11R6_XIM
+
+/* If preedit text is set on F, cancel preedit, free the text, and
+ generate the appropriate events to cancel the preedit display.
+
+ This is mainly useful when the connection to the IM server is
+ dropped during preconversion. */
+
+static void
+x_maybe_clear_preedit (struct frame *f)
+{
+ struct x_output *output;
+ struct input_event ie;
+
+ output = FRAME_X_OUTPUT (f);
+
+ if (!output->preedit_chars)
+ return;
+
+ EVENT_INIT (ie);
+ ie.kind = PREEDIT_TEXT_EVENT;
+ ie.arg = Qnil;
+ XSETFRAME (ie.frame_or_window, f);
+ XSETINT (ie.x, 0);
+ XSETINT (ie.y, 0);
+ kbd_buffer_store_event (&ie);
+
+ xfree (output->preedit_chars);
+
+ output->preedit_size = 0;
+ output->preedit_active = false;
+ output->preedit_chars = NULL;
+ output->preedit_caret = 0;
+}
+
/* XIM destroy callback function, which is called whenever the
connection to input method XIM dies. CLIENT_DATA contains a
pointer to the x_display_info structure corresponding to XIM. */
@@ -25531,6 +26224,9 @@ xim_destroy_callback (XIM xim, XPointer client_data,
XPointer call_data)
{
FRAME_XIC (f) = NULL;
xic_free_xfontset (f);
+
+ /* Free the preedit text if necessary. */
+ x_maybe_clear_preedit (f);
}
}
@@ -25540,6 +26236,8 @@ xim_destroy_callback (XIM xim, XPointer client_data,
XPointer call_data)
unblock_input ();
}
+#endif
+
#endif /* HAVE_X11R6 */
/* Open the connection to the XIM server on display DPYINFO.
@@ -26901,6 +27599,64 @@ xembed_request_focus (struct frame *f)
XEMBED_REQUEST_FOCUS, 0, 0, 0);
}
+static Bool
+server_timestamp_predicate (Display *display, XEvent *xevent,
+ XPointer arg)
+{
+ XID *args = (XID *) arg;
+
+ if (xevent->type == PropertyNotify
+ && xevent->xproperty.window == args[0]
+ && xevent->xproperty.atom == args[1])
+ return True;
+
+ return False;
+}
+
+/* Get the server time. The X server is guaranteed to deliver the
+ PropertyNotify event, so there is no reason to use x_if_event. */
+
+static Time
+x_get_server_time (struct frame *f)
+{
+ Atom property_atom;
+ XEvent property_dummy;
+ struct x_display_info *dpyinfo;
+ XID client_data[2];
+#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME
+ uint_fast64_t current_monotonic_time;
+#endif
+
+ /* If the server time is the same as the monotonic time, avoid a
+ roundtrip by using that instead. */
+
+#if defined HAVE_XSYNC && !defined USE_GTK && defined HAVE_CLOCK_GETTIME
+ if (FRAME_DISPLAY_INFO (f)->server_time_monotonic_p)
+ {
+ current_monotonic_time = x_sync_current_monotonic_time ();
+
+ if (current_monotonic_time)
+ /* Truncate the time to CARD32. */
+ return (current_monotonic_time / 1000) & X_ULONG_MAX;
+ }
+#endif
+
+ dpyinfo = FRAME_DISPLAY_INFO (f);
+ property_atom = dpyinfo->Xatom_EMACS_SERVER_TIME_PROP;
+ client_data[0] = FRAME_OUTER_WINDOW (f);
+ client_data[1] = property_atom;
+
+ XChangeProperty (dpyinfo->display, FRAME_OUTER_WINDOW (f),
+ property_atom, XA_ATOM, 32,
+ PropModeReplace,
+ (unsigned char *) &property_atom, 1);
+
+ XIfEvent (dpyinfo->display, &property_dummy,
+ server_timestamp_predicate, (XPointer) client_data);
+
+ return property_dummy.xproperty.time;
+}
+
/* Activate frame with Extended Window Manager Hints */
static void
@@ -26908,6 +27664,7 @@ x_ewmh_activate_frame (struct frame *f)
{
XEvent msg;
struct x_display_info *dpyinfo;
+ Time time;
dpyinfo = FRAME_DISPLAY_INFO (f);
@@ -26928,6 +27685,42 @@ x_ewmh_activate_frame (struct frame *f)
msg.xclient.data.l[3] = 0;
msg.xclient.data.l[4] = 0;
+ /* No frame is currently focused on that display, so apply any
+ bypass for focus stealing prevention that the user has
+ specified. */
+ if (!dpyinfo->x_focus_frame)
+ {
+ if (EQ (Vx_allow_focus_stealing, Qimitate_pager))
+ msg.xclient.data.l[0] = 2;
+ else if (EQ (Vx_allow_focus_stealing, Qnewer_time))
+ {
+ block_input ();
+ time = x_get_server_time (f);
+#ifdef USE_GTK
+ x_set_gtk_user_time (f, time);
+#endif
+ /* Temporarily override dpyinfo->x_focus_frame so the
+ user time property is set on the right window. */
+ dpyinfo->x_focus_frame = f;
+ x_display_set_last_user_time (dpyinfo, time, true, true);
+ dpyinfo->x_focus_frame = NULL;
+ unblock_input ();
+
+ msg.xclient.data.l[1] = time;
+ }
+ else if (EQ (Vx_allow_focus_stealing, Qraise_and_focus))
+ {
+ time = x_get_server_time (f);
+
+ x_set_input_focus (FRAME_DISPLAY_INFO (f),
+ FRAME_OUTER_WINDOW (f),
+ time);
+ XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f));
+
+ return;
+ }
+ }
+
XSendEvent (dpyinfo->display, dpyinfo->root_window,
False, (SubstructureRedirectMask
| SubstructureNotifyMask), &msg);
@@ -26948,6 +27741,76 @@ x_get_focus_frame (struct frame *f)
return lisp_focus;
}
+/* Return the toplevel parent of F, if it is a child frame.
+ Otherwise, return NULL. */
+
+static struct frame *
+x_get_toplevel_parent (struct frame *f)
+{
+ struct frame *parent;
+
+ if (!FRAME_PARENT_FRAME (f))
+ return NULL;
+
+ parent = FRAME_PARENT_FRAME (f);
+
+ while (FRAME_PARENT_FRAME (parent))
+ parent = FRAME_PARENT_FRAME (parent);
+
+ return parent;
+}
+
+static void
+x_set_input_focus (struct x_display_info *dpyinfo, Window window,
+ Time time)
+{
+#ifdef HAVE_XINPUT2
+ struct xi_device_t *device;
+#endif
+
+ /* Do the equivalent of XSetInputFocus with the specified window and
+ time, but use the attachment to the device that Emacs has
+ designated the client pointer on X Input Extension builds.
+ Asynchronously trap errors around the generated XI_SetFocus or
+ SetInputFocus request, in case the device has been destroyed or
+ the window obscured.
+
+ The revert_to will be set to RevertToParent for generated
+ SetInputFocus requests. */
+
+#ifdef HAVE_XINPUT2
+ if (dpyinfo->supports_xi2
+ && dpyinfo->client_pointer_device != -1)
+ {
+ device = xi_device_from_id (dpyinfo, dpyinfo->client_pointer_device);
+
+ /* The device is a master pointer. Use its attachment, which
+ should be the master keyboard. */
+
+ if (device)
+ {
+ eassert (device->use == XIMasterPointer);
+
+ x_ignore_errors_for_next_request (dpyinfo);
+ XISetFocus (dpyinfo->display, device->attachment,
+ /* Note that the input extension
+ only supports RevertToParent-type
+ behavior. */
+ window, time);
+ x_stop_ignoring_errors (dpyinfo);
+
+ return;
+ }
+ }
+#endif
+
+ /* Otherwise, use the pointer device that the X server says is the
+ client pointer. */
+ x_ignore_errors_for_next_request (dpyinfo);
+ XSetInputFocus (dpyinfo->display, window, RevertToParent, time);
+ x_stop_ignoring_errors (dpyinfo);
+}
+
/* In certain situations, when the window manager follows a
click-to-focus policy, there seems to be no way around calling
XSetInputFocus to give another frame the input focus.
@@ -26961,6 +27824,7 @@ static void
x_focus_frame (struct frame *f, bool noactivate)
{
struct x_display_info *dpyinfo;
+ Time time;
dpyinfo = FRAME_DISPLAY_INFO (f);
@@ -26972,6 +27836,18 @@ x_focus_frame (struct frame *f, bool noactivate)
else
{
if (!noactivate
+ /* If F is override-redirect, use SetInputFocus instead.
+ Override-redirect frames are not subject to window
+ management. */
+ && !FRAME_OVERRIDE_REDIRECT (f)
+ /* If F is a child frame, use SetInputFocus instead. This
+ may not work if its parent is not activated. */
+ && !FRAME_PARENT_FRAME (f)
+ /* If the focus is being transferred from a child frame to
+ its toplevel parent, also use SetInputFocus. */
+ && (!dpyinfo->x_focus_frame
+ || (x_get_toplevel_parent (dpyinfo->x_focus_frame)
+ != f))
&& x_wm_supports (f, dpyinfo->Xatom_net_active_window))
{
/* When window manager activation is possible, use it
@@ -26983,11 +27859,36 @@ x_focus_frame (struct frame *f, bool noactivate)
return;
}
- /* Ignore any BadMatch error this request might result in. */
- x_ignore_errors_for_next_request (dpyinfo);
- XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f),
- RevertToParent, CurrentTime);
- x_stop_ignoring_errors (dpyinfo);
+ if (NILP (Vx_no_window_manager))
+ {
+ /* Use the last user time. It is invalid to use CurrentTime
+ according to the ICCCM:
+
+ Clients that use a SetInputFocus request must set the
+ time field to the timestamp of the event that caused
+ them to make the attempt. [...] Note that clients must
+ not use CurrentTime in the time field. */
+ time = dpyinfo->last_user_time;
+
+ /* Unless the focus doesn't belong to Emacs anymore and
+ `x-allow-focus-stealing' is set to Qnewer_time. */
+ if (EQ (Vx_allow_focus_stealing, Qnewer_time)
+ && !dpyinfo->x_focus_frame)
+ time = x_get_server_time (f);
+
+ /* Ignore any BadMatch error this request might result in.
+ A BadMatch error can occur if the window was obscured
+ after the time of the last user interaction without
+ changing the last-focus-change-time. */
+ x_set_input_focus (FRAME_DISPLAY_INFO (f), FRAME_OUTER_WINDOW (f),
+ time);
+ }
+ else
+ x_set_input_focus (FRAME_DISPLAY_INFO (f), FRAME_OUTER_WINDOW (f),
+ /* But when no window manager is in use,
+ respecting the ICCCM doesn't really
+ matter. */
+ CurrentTime);
}
}
@@ -27930,6 +28831,9 @@ x_wm_set_size_hint (struct frame *f, long flags, bool
user_position)
Window window = FRAME_OUTER_WINDOW (f);
#ifdef USE_X_TOOLKIT
WMShellWidget shell;
+#ifndef USE_MOTIF
+ bool hints_changed;
+#endif
#endif
if (!window)
@@ -27956,10 +28860,14 @@ x_wm_set_size_hint (struct frame *f, long flags, bool
user_position)
shell->wm.size_hints.flags |= USPosition;
}
+#ifndef USE_MOTIF
+ hints_changed
+ = widget_update_wm_size_hints (f->output_data.x->widget,
+ f->output_data.x->edit_widget);
+#else
widget_update_wm_size_hints (f->output_data.x->widget,
f->output_data.x->edit_widget);
-#ifdef USE_MOTIF
/* Do this all over again for the benefit of Motif, which always
knows better than the programmer. */
shell->wm.size_hints.flags &= ~(PPosition | USPosition);
@@ -27970,6 +28878,7 @@ x_wm_set_size_hint (struct frame *f, long flags, bool
user_position)
shell->wm.size_hints.flags &= ~PPosition;
shell->wm.size_hints.flags |= USPosition;
}
+#endif
/* Drill hints into Motif, since it keeps setting its own. */
size_hints.flags = shell->wm.size_hints.flags;
@@ -27987,15 +28896,23 @@ x_wm_set_size_hint (struct frame *f, long flags, bool
user_position)
size_hints.min_aspect.y = shell->wm.size_hints.min_aspect.y;
size_hints.max_aspect.x = shell->wm.size_hints.max_aspect.x;
size_hints.max_aspect.y = shell->wm.size_hints.max_aspect.y;
-#ifdef HAVE_X11XTR6
size_hints.base_width = shell->wm.base_width;
size_hints.base_height = shell->wm.base_height;
size_hints.win_gravity = shell->wm.win_gravity;
-#endif
+#ifdef USE_MOTIF
XSetWMNormalHints (XtDisplay (f->output_data.x->widget),
XtWindow (f->output_data.x->widget),
&size_hints);
+#else
+ /* In many cases, widget_update_wm_size_hints will not have
+ updated the size hints if only flags changed. When that
+ happens, set the WM hints manually. */
+
+ if (!hints_changed)
+ XSetWMNormalHints (XtDisplay (f->output_data.x->widget),
+ XtWindow (f->output_data.x->widget),
+ &size_hints);
#endif
return;
@@ -28410,9 +29327,10 @@ xi_check_toolkit (Display *display)
#endif
-/* Open a connection to X display DISPLAY_NAME, and return
- the structure that describes the open display.
- If we cannot contact the display, return null. */
+/* Open a connection to X display DISPLAY_NAME, and return the
+ structure that describes the open display. If obtaining the XCB
+ connection or toolkit-specific display fails, return NULL. Signal
+ an error if opening the display itself failed. */
struct x_display_info *
x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name)
@@ -28430,6 +29348,21 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
GdkDisplay *gdpy;
GdkScreen *gscr;
#endif
+#ifdef HAVE_XFIXES
+ Lisp_Object tem, lisp_name;
+ int num_fast_selections;
+ Atom selection_name;
+#ifdef USE_XCB
+ xcb_get_selection_owner_cookie_t *selection_cookies;
+ xcb_get_selection_owner_reply_t *selection_reply;
+ xcb_generic_error_t *selection_error;
+#endif
+#endif
+ int i;
+
+#if defined HAVE_XFIXES && defined USE_XCB
+ USE_SAFE_ALLOCA;
+#endif
block_input ();
@@ -28439,9 +29372,13 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
++x_initialized;
}
- if (! x_display_ok (SSDATA (display_name)))
+#if defined USE_X_TOOLKIT || defined USE_GTK
+
+ if (!x_display_ok (SSDATA (display_name)))
error ("Display %s can't be opened", SSDATA (display_name));
+#endif
+
#ifdef USE_GTK
{
#define NUM_ARGV 10
@@ -28568,13 +29505,26 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
/* Detect failure. */
if (dpy == 0)
{
+#if !defined USE_X_TOOLKIT && !defined USE_GTK
+ /* Avoid opening a display three times (once in dispextern.c
+ upon startup, once in x_display_ok, and once above) to
+ determine whether or not the display is alive on no toolkit
+ builds, where no toolkit initialization happens at all. */
+
+ error ("Display %s can't be opened", SSDATA (display_name));
+#endif
+
unblock_input ();
+
+#if defined HAVE_XFIXES && defined USE_XCB
+ SAFE_FREE ();
+#endif
return 0;
}
#ifdef USE_XCB
xcb_conn = XGetXCBConnection (dpy);
- if (xcb_conn == 0)
+ if (!xcb_conn)
{
#ifdef USE_GTK
xg_display_close (dpy);
@@ -28587,6 +29537,10 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
#endif /* ! USE_GTK */
unblock_input ();
+
+#if defined HAVE_XFIXES && defined USE_XCB
+ SAFE_FREE ();
+#endif
return 0;
}
#endif
@@ -29056,11 +30010,10 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
xi_select_hierarchy_events (dpyinfo);
#endif
+ dpyinfo->xi2_version = minor;
x_cache_xi_devices (dpyinfo);
}
}
-
- dpyinfo->xi2_version = minor;
skip_xi_setup:
;
#endif
@@ -29139,8 +30092,7 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
XkbUseCoreKbd);
if (dpyinfo->xkb_desc)
- XkbGetNames (dpyinfo->display,
- XkbGroupNamesMask | XkbVirtualModNamesMask,
+ XkbGetNames (dpyinfo->display, XkbAllNamesMask,
dpyinfo->xkb_desc);
XkbSelectEvents (dpyinfo->display, XkbUseCoreKbd,
@@ -29150,9 +30102,10 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
#endif
#ifdef HAVE_XFIXES
- int xfixes_event_base, xfixes_error_base;
+ int xfixes_error_base;
dpyinfo->xfixes_supported_p
- = XFixesQueryExtension (dpyinfo->display, &xfixes_event_base,
+ = XFixesQueryExtension (dpyinfo->display,
+ &dpyinfo->xfixes_event_base,
&xfixes_error_base);
if (dpyinfo->xfixes_supported_p)
@@ -29203,7 +30156,6 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
XScreenNumberOfScreen (dpyinfo->screen));
{
- int i;
enum { atom_count = ARRAYELTS (x_atom_refs) };
/* 1 for _XSETTINGS_SN. */
enum { total_atom_count = 2 + atom_count };
@@ -29276,21 +30228,30 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
{
XrmValue d, fr, to;
Font font;
+ XFontStruct *query_result;
dpy = dpyinfo->display;
- d.addr = (XPointer)&dpy;
+ d.addr = (XPointer) &dpy;
d.size = sizeof (Display *);
fr.addr = (char *) XtDefaultFont;
fr.size = sizeof (XtDefaultFont);
to.size = sizeof (Font *);
- to.addr = (XPointer)&font;
+ to.addr = (XPointer) &font;
x_catch_errors (dpy);
if (!XtCallConverter (dpy, XtCvtStringToFont, &d, 1, &fr, &to, NULL))
emacs_abort ();
- if (x_had_errors_p (dpy) || !XQueryFont (dpy, font))
+ query_result = XQueryFont (dpy, font);
+
+ /* Set the dialog font to some fallback (here, 9x15) if the font
+ specified is invalid. */
+ if (x_had_errors_p (dpy) || !font)
XrmPutLineResource (&xrdb, "Emacs.dialog.*.font: 9x15");
- /* Do not free XFontStruct returned by the above call to XQueryFont.
- This leads to X protocol errors at XtCloseDisplay (Bug#18403). */
+
+ /* Do not destroy the font struct returned above with XFreeFont;
+ that also destroys the font, leading to X protocol errors at
+ XtCloseDisplay. Just free the font info structure.
+ (Bug#18403) */
+ XFreeFontInfo (NULL, query_result, 1);
x_uncatch_errors ();
}
#endif
@@ -29371,8 +30332,102 @@ x_term_init (Lisp_Object display_name, char
*xrm_option, char *resource_name)
dpyinfo->protected_windows_max = 256;
#endif
+#ifdef HAVE_XFIXES
+ /* Initialize selection tracking for the selections in
+ x-fast-selection-list. */
+
+ if (CONSP (Vx_fast_selection_list)
+ && dpyinfo->xfixes_supported_p
+ && dpyinfo->xfixes_major >= 1)
+ {
+ num_fast_selections = 0;
+ tem = Vx_fast_selection_list;
+
+ FOR_EACH_TAIL_SAFE (tem)
+ {
+ if (!SYMBOLP (XCAR (tem)))
+ continue;
+
+ num_fast_selections++;
+ }
+
+ dpyinfo->n_monitored_selections = num_fast_selections;
+ dpyinfo->selection_tracking_window
+ = x_create_special_window (dpyinfo, dpyinfo->root_window);
+ dpyinfo->monitored_selections
+ = xmalloc (num_fast_selections
+ * sizeof *dpyinfo->monitored_selections);
+
+ num_fast_selections = 0;
+ tem = Vx_fast_selection_list;
+
+ FOR_EACH_TAIL_SAFE (tem)
+ {
+ lisp_name = XCAR (tem);
+
+ if (!SYMBOLP (lisp_name))
+ continue;
+
+ selection_name = symbol_to_x_atom (dpyinfo, lisp_name);
+ dpyinfo->monitored_selections[num_fast_selections++].name
+ = selection_name;
+ dpyinfo->monitored_selections[num_fast_selections - 1].owner
+ = X_INVALID_WINDOW;
+
+ /* Select for selection input. */
+ XFixesSelectSelectionInput (dpyinfo->display,
+ dpyinfo->selection_tracking_window,
+ selection_name,
+ (XFixesSetSelectionOwnerNotifyMask
+ | XFixesSetSelectionOwnerNotifyMask
+ | XFixesSelectionClientCloseNotifyMask));
+ }
+
+#ifdef USE_XCB
+ selection_cookies = SAFE_ALLOCA (sizeof *selection_cookies
+ * num_fast_selections);
+#endif
+
+ /* Now, ask for the current owners of all those selections. */
+ for (i = 0; i < num_fast_selections; ++i)
+ {
+#ifdef USE_XCB
+ selection_cookies[i]
+ = xcb_get_selection_owner (dpyinfo->xcb_connection,
+ dpyinfo->monitored_selections[i].name);
+#else
+ dpyinfo->monitored_selections[i].owner
+ = XGetSelectionOwner (dpyinfo->display,
+ dpyinfo->monitored_selections[i].name);
+#endif
+ }
+
+#ifdef USE_XCB
+ for (i = 0; i < num_fast_selections; ++i)
+ {
+ selection_reply
+ = xcb_get_selection_owner_reply (dpyinfo->xcb_connection,
+ selection_cookies[i],
+ &selection_error);
+
+ if (selection_reply)
+ {
+ dpyinfo->monitored_selections[i].owner
+ = selection_reply->owner;
+ free (selection_reply);
+ }
+ else if (selection_error)
+ free (selection_error);
+ }
+#endif
+ }
+#endif
+
unblock_input ();
+#if defined HAVE_XFIXES && defined USE_XCB
+ SAFE_FREE ();
+#endif
return dpyinfo;
}
@@ -29508,6 +30563,10 @@ x_delete_display (struct x_display_info *dpyinfo)
xfree (dpyinfo->x_id_name);
xfree (dpyinfo->x_dnd_atoms);
xfree (dpyinfo->color_cells);
+#ifdef HAVE_XFIXES
+ if (dpyinfo->monitored_selections)
+ xfree (dpyinfo->monitored_selections);
+#endif
#ifdef USE_TOOLKIT_SCROLL_BARS
xfree (dpyinfo->protected_windows);
#endif
@@ -29679,11 +30738,6 @@ x_delete_terminal (struct terminal *terminal)
closing all the displays. */
XrmDestroyDatabase (dpyinfo->rdb);
#endif
-
-#ifdef HAVE_XKB
- if (dpyinfo->xkb_desc)
- XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True);
-#endif
#ifdef USE_GTK
xg_display_close (dpyinfo->display);
#else
@@ -29693,9 +30747,6 @@ x_delete_terminal (struct terminal *terminal)
XCloseDisplay (dpyinfo->display);
#endif
#endif /* ! USE_GTK */
-
- if (dpyinfo->modmap)
- XFreeModifiermap (dpyinfo->modmap);
/* Do not close the connection here because it's already closed
by X(t)CloseDisplay (Bug#18403). */
dpyinfo->display = NULL;
@@ -29708,6 +30759,18 @@ x_delete_terminal (struct terminal *terminal)
else if (dpyinfo->connection >= 0)
emacs_close (dpyinfo->connection);
+ /* Free the keyboard and modifier maps here; that is safe to do
+ without a display, and not doing so leads to a lot of data being
+ leaked upon IO error. */
+
+#ifdef HAVE_XKB
+ if (dpyinfo->xkb_desc)
+ XkbFreeKeyboard (dpyinfo->xkb_desc, XkbAllComponentsMask, True);
+#endif
+
+ if (dpyinfo->modmap)
+ XFreeModifiermap (dpyinfo->modmap);
+
/* No more input on this descriptor. */
delete_keyboard_wait_descriptor (dpyinfo->connection);
/* Mark as dead. */
@@ -29890,7 +30953,7 @@ mark_xterm (void)
{
Lisp_Object val;
#if defined HAVE_XINPUT2 || defined USE_TOOLKIT_SCROLL_BARS \
- || defined HAVE_XRANDR || defined USE_GTK
+ || defined HAVE_XRANDR || defined USE_GTK || defined HAVE_X_I18N
struct x_display_info *dpyinfo;
#if defined HAVE_XINPUT2 || defined USE_TOOLKIT_SCROLL_BARS
int i;
@@ -30114,8 +31177,14 @@ x_get_keyboard_modifiers (struct x_display_info
*dpyinfo)
/* This sometimes happens when the function is called during display
initialization, which can happen while obtaining vendor specific
keysyms. */
+
+#ifdef HAVE_XKB
if (!dpyinfo->xkb_desc && !dpyinfo->modmap)
x_find_modifier_meanings (dpyinfo);
+#else
+ if (!dpyinfo->modmap)
+ x_find_modifier_meanings (dpyinfo);
+#endif
return list5 (make_uint (dpyinfo->hyper_mod_mask),
make_uint (dpyinfo->super_mod_mask),
@@ -30235,6 +31304,10 @@ With MS Windows, Haiku windowing or Nextstep, the
value is t. */);
Fput (Qsuper, Qmodifier_value, make_fixnum (super_modifier));
DEFSYM (QXdndSelection, "XdndSelection");
DEFSYM (Qx_selection_alias_alist, "x-selection-alias-alist");
+ DEFSYM (Qimitate_pager, "imitate-pager");
+ DEFSYM (Qnewer_time, "newer-time");
+ DEFSYM (Qraise_and_focus, "raise-and-focus");
+ DEFSYM (Qreally_fast, "really-fast");
DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym,
doc: /* Which keys Emacs uses for the ctrl modifier.
@@ -30475,4 +31548,58 @@ It should accept a single argument, a string
describing the locale of
the input method, and return a coding system that can decode keyboard
input generated by said input method. */);
Vx_input_coding_function = Qnil;
+
+ DEFVAR_LISP ("x-fast-selection-list", Vx_fast_selection_list,
+ doc: /* List of selections for which `x-selection-exists-p' should be fast.
+
+List of selection names as atoms that will be monitored by Emacs for
+ownership changes when the X server supports the XFIXES extension.
+The result of the monitoring is then used by `x-selection-exists-p' to
+avoid a server round trip, which is important as it is called while
+updating the tool bar. The value of this variable is only read upon
+connection setup. */);
+ /* The default value of this variable is chosen so that updating the
+ tool bar does not require a call to _XReply. */
+ Vx_fast_selection_list = list1 (QCLIPBOARD);
+
+ DEFVAR_LISP ("x-allow-focus-stealing", Vx_allow_focus_stealing,
+ doc: /* How to bypass window manager focus stealing prevention.
+
+Some window managers prevent `x-focus-frame' from activating the given
+frame when Emacs is in the background, which is especially prone to
+cause problems when the Emacs server wants to activate itself.
+
+In addition, when an old-fashioned (pre-EWMH) window manager is being
+run and `x-no-window-manager' is nil, the X server will not let Emacs
+focus itself if another program was focused after the last time Emacs
+obtained the input focus.
+
+This variable specifies the strategy used to activate frames when that
+is the case, and has several valid values (any other value means to
+not bypass window manager focus stealing prevention):
+
+ - The symbol `imitate-pager', which means to pretend that Emacs is a
+ pager.
+
+ - The symbol `newer-time', which means to fetch the current time
+ from the X server and use it to activate the frame.
+
+ - The symbol `raise-and-focus', which means to raise the window and
+ focus it manually. */);
+ Vx_allow_focus_stealing = Qnewer_time;
+
+ DEFVAR_LISP ("x-use-fast-mouse-position", Vx_use_fast_mouse_position,
+ doc: /* How to make `mouse-position' faster.
+
+`mouse-position' and `mouse-pixel-position' default to querying the X
+server for the window under the mouse pointer. This results in
+accurate results, but is also very slow when the X connection has
+moderate to high latency. Setting this variable to a non-nil value
+makes Emacs query only for the position of the pointer, which is
+usually faster. Doing so improves the performance of dragging to
+select text over slow X connections.
+
+If that is still too slow, setting this variable to the symbol
+`really-fast' will make Emacs return only cached values. */);
+ Vx_use_fast_mouse_position = Qnil;
}
diff --git a/src/xterm.h b/src/xterm.h
index b68a234faa..c36920081d 100644
--- a/src/xterm.h
+++ b/src/xterm.h
@@ -213,20 +213,32 @@ struct color_name_cache_entry
#ifdef HAVE_XINPUT2
#ifdef HAVE_XINPUT2_1
+
struct xi_scroll_valuator_t
{
- bool invalid_p;
- bool pending_enter_reset;
+ /* The ID of the valuator. */
+ int number;
+
+ /* Whether or not it represents X axis movement. */
+ bool_bf horizontal : 1;
+
+ /* Whether or not the value is currently invalid. */
+ bool_bf invalid_p : 1;
+
+ /* The current value. */
double current_value;
+
+ /* Value used to tally up deltas until a threshold is met. */
double emacs_value;
- double increment;
- int number;
- int horizontal;
+ /* The scroll increment. */
+ double increment;
};
+
#endif
#ifdef HAVE_XINPUT2_2
+
struct xi_touch_point_t
{
struct xi_touch_point_t *next;
@@ -234,6 +246,7 @@ struct xi_touch_point_t
int number;
double x, y;
};
+
#endif
struct xi_device_t
@@ -295,8 +308,7 @@ struct xi_device_t
};
#endif
-Status x_parse_color (struct frame *f, const char *color_name,
- XColor *color);
+extern Status x_parse_color (struct frame *, const char *, XColor *);
struct x_failable_request
{
@@ -308,6 +320,22 @@ struct x_failable_request
unsigned long end;
};
+#ifdef HAVE_XFIXES
+
+struct x_monitored_selection
+{
+ /* The name of the selection. */
+ Atom name;
+
+ /* The current owner of the selection. */
+ Window owner;
+};
+
+/* An invalid window. */
+#define X_INVALID_WINDOW 0xffffffff
+
+#endif
+
/* For each X display, we have a structure that records
information about it. */
@@ -552,7 +580,9 @@ struct x_display_info
Time last_user_time;
/* Position where the mouse was last time we reported a motion.
- This is a position on last_mouse_motion_frame. */
+ This is a position on last_mouse_motion_frame. It is used in
+ some situations to report the mouse position as well: see
+ XTmouse_position. */
int last_mouse_motion_x;
int last_mouse_motion_y;
@@ -778,6 +808,7 @@ struct x_display_info
bool xfixes_supported_p;
int xfixes_major;
int xfixes_minor;
+ int xfixes_event_base;
#endif
#ifdef HAVE_XSYNC
@@ -828,6 +859,17 @@ struct x_display_info
/* Pointer to the next request in `failable_requests'. */
struct x_failable_request *next_failable_request;
+#ifdef HAVE_XFIXES
+ /* Array of selections being monitored and their owners. */
+ struct x_monitored_selection *monitored_selections;
+
+ /* Window used to monitor those selections. */
+ Window selection_tracking_window;
+
+ /* The number of those selections. */
+ int n_monitored_selections;
+#endif
+
/* The pending drag-and-drop time for middle-click based
drag-and-drop emulation. */
Time pending_dnd_time;
@@ -916,11 +958,6 @@ struct x_output
Picture picture;
#endif
- /* Flag that indicates whether we've modified the back buffer and
- need to publish our modifications to the front buffer at a
- convenient time. */
- bool need_buffer_flip;
-
/* The X window used for the bitmap icon;
or 0 if we don't have a bitmap icon. */
Window icon_desc;
@@ -1091,6 +1128,18 @@ struct x_output
and inactive states. */
bool_bf alpha_identical_p : 1;
+#ifdef HAVE_XDBE
+ /* Flag that indicates whether we've modified the back buffer and
+ need to publish our modifications to the front buffer at a
+ convenient time. */
+ bool_bf need_buffer_flip : 1;
+
+ /* Flag that indicates whether or not the frame contents are
+ complete and can be safely flushed while handling async
+ input. */
+ bool_bf complete : 1;
+#endif
+
#ifdef HAVE_X_I18N
/* Input context (currently, this means Compose key handler setup). */
XIC xic;
@@ -1248,6 +1297,10 @@ extern void x_mark_frame_dirty (struct frame *f);
/* Return the need-buffer-flip flag for frame F. */
#define FRAME_X_NEED_BUFFER_FLIP(f) ((f)->output_data.x->need_buffer_flip)
+
+/* Return whether or not the frame F has been completely drawn. Used
+ while handling async input. */
+#define FRAME_X_COMPLETE_P(f) ((f)->output_data.x->complete)
#endif
/* Return the outermost X window associated with the frame F. */
@@ -1554,22 +1607,15 @@ SELECTION_EVENT_DISPLAY (struct selection_input_event
*ev)
extern void x_free_gcs (struct frame *);
extern void x_relative_mouse_position (struct frame *, int *, int *);
-extern void x_real_pos_and_offsets (struct frame *f,
- int *left_offset_x,
- int *right_offset_x,
- int *top_offset_y,
- int *bottom_offset_y,
- int *x_pixels_diff,
- int *y_pixels_diff,
- int *xptr,
- int *yptr,
- int *outer_border);
-extern void x_default_font_parameter (struct frame* f, Lisp_Object parms);
+extern void x_real_pos_and_offsets (struct frame *, int *, int *, int *,
+ int *, int *, int *, int *, int *,
+ int *);
+extern void x_default_font_parameter (struct frame *, Lisp_Object);
/* From xrdb.c. */
-XrmDatabase x_load_resources (Display *, const char *, const char *,
- const char *);
+extern XrmDatabase x_load_resources (Display *, const char *, const char *,
+ const char *);
extern const char *x_get_string_resource (void *, const char *, const char *);
/* Defined in xterm.c */
@@ -1645,6 +1691,10 @@ extern void x_cr_draw_frame (cairo_t *, struct frame *);
extern Lisp_Object x_cr_export_frames (Lisp_Object, cairo_surface_type_t);
#endif
+#ifdef HAVE_XFIXES
+extern Window x_find_selection_owner (struct x_display_info *, Atom);
+#endif
+
#ifdef HAVE_XRENDER
extern void x_xrender_color_from_gc_background (struct frame *, GC,
XRenderColor *, bool);
@@ -1653,6 +1703,12 @@ extern void x_xr_apply_ext_clip (struct frame *, GC);
extern void x_xr_reset_ext_clip (struct frame *);
#endif
+extern void x_translate_coordinates (struct frame *, int, int, int *, int *);
+extern void x_translate_coordinates_to_root (struct frame *, int, int,
+ int *, int *);
+extern Lisp_Object x_handle_translate_coordinates (struct frame *, Lisp_Object,
+ int, int);
+
extern Bool x_query_pointer (Display *, Window, Window *, Window *, int *,
int *, int *, int *, unsigned int *);
diff --git a/test/lisp/apropos-tests.el b/test/lisp/apropos-tests.el
index 289700abf7..917c08b911 100644
--- a/test/lisp/apropos-tests.el
+++ b/test/lisp/apropos-tests.el
@@ -120,14 +120,15 @@
(should (apropos-true-hit "foo bar baz" '("foo" "bar"))))
(ert-deftest apropos-tests-format-plist ()
- (setplist 'foo '(a 1 b (2 3) c nil))
- (apropos-parse-pattern '("b"))
- (should (equal (apropos-format-plist 'foo ", ")
- "a 1, b (2 3), c nil"))
- (should (equal (apropos-format-plist 'foo ", " t)
- "b (2 3)"))
- (apropos-parse-pattern '("d"))
- (should-not (apropos-format-plist 'foo ", " t)))
+ (let ((foo (make-symbol "foo")))
+ (setplist foo '(a 1 b (2 3) c nil))
+ (apropos-parse-pattern '("b"))
+ (should (equal (apropos-format-plist foo ", ")
+ "a 1, b (2 3), c nil"))
+ (should (equal (apropos-format-plist foo ", " t)
+ "b (2 3)"))
+ (apropos-parse-pattern '("d"))
+ (should-not (apropos-format-plist foo ", " t))))
(provide 'apropos-tests)
;;; apropos-tests.el ends here
diff --git a/test/lisp/auth-source-pass-tests.el
b/test/lisp/auth-source-pass-tests.el
index f5147a7ce0..6e6671efca 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -25,7 +25,7 @@
;;; Code:
-(require 'ert)
+(require 'ert-x)
(require 'auth-source-pass)
@@ -59,7 +59,7 @@
"Contains a list of all messages passed to `auth-source-do-debug'.")
(defun auth-source-pass--have-message-matching (regexp)
- "Return non-nil iff at least one `auth-source-do-debug' match REGEXP."
+ "Return non-nil if at least one `auth-source-do-debug' match REGEXP."
(seq-find (lambda (message)
(string-match regexp message))
auth-source-pass--debug-log))
@@ -109,7 +109,7 @@ ENTRY, HOSTNAME, USER and PORT are the same as in
(put 'auth-source-pass-match-entry-p 'ert-explainer
#'auth-source-pass--explain-match-entry-p)
(defun auth-source-pass--includes-sorted-entries (entries hostname &optional
user port)
- "Return non-nil iff ENTRIES matching the parameters are found in store.
+ "Return non-nil if ENTRIES matching the parameters are found in store.
ENTRIES should be sorted from most specific to least specific.
HOSTNAME, USER and PORT are passed unchanged to
@@ -157,7 +157,7 @@ result is ordered the same way as the suffixes."
(auth-source-pass--generate-entry-suffixes hostname user port))))
(defun auth-source-pass-match-entry-p (entry hostname &optional user port)
- "Return non-nil iff an ENTRY matching the parameters is found in store.
+ "Return non-nil if an ENTRY matching the parameters is found in store.
HOSTNAME, USER and PORT are passed unchanged to
`auth-source-pass--matching-entries'."
@@ -166,7 +166,7 @@ HOSTNAME, USER and PORT are passed unchanged to
(auth-source-pass--matching-entries hostname user port)))
(defun auth-source-pass-match-any-entry-p (hostname &optional user port)
- "Return non-nil iff there is at least one entry matching the parameters.
+ "Return non-nil if there is at least one entry matching the parameters.
HOSTNAME, USER and PORT are passed unchanged to
`auth-source-pass--matching-entries'."
@@ -466,7 +466,10 @@ HOSTNAME, USER and PORT are passed unchanged to
(ert-deftest auth-source-pass-can-start-from-auth-source-search ()
(auth-source-pass--with-store '(("gitlab.com" ("user" . "someone")))
(auth-source-pass-enable)
- (let ((result (car (auth-source-search :host "gitlab.com"))))
+ ;; This also asserts an aspect of traditional search behavior
+ ;; relative to `auth-source-pass-extra-query-keywords'.
+ (let* ((auth-source-pass-extra-query-keywords nil)
+ (result (car (auth-source-search :host "gitlab.com"))))
(should (equal (plist-get result :user) "someone"))
(should (equal (plist-get result :host) "gitlab.com")))))
@@ -488,6 +491,266 @@ HOSTNAME, USER and PORT are passed unchanged to
(should (auth-source-pass--have-message-matching
"found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\"
\"b/gitlab.com\")"))))
+
+;;;; Option `auth-source-pass-extra-query-keywords' (bug#58985)
+
+;; No entry has the requested port, but a result is still returned.
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "x.com" :port 22 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "x.com" :secret "a")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss ()
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("x.com:42" (secret . "b")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "x.com" :port 22 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "x.com" :secret "a")))))))
+
+;; One of two entries has the requested port, both returned.
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "x.com" :port 42 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "x.com" :secret "a")
+ (:host "x.com" :port "42" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit ()
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("x.com:42" (secret . "b")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "x.com" :port 42 :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "x.com" :secret "a")
+ (:host "x.com" :port 42 :secret "b")))))))
+
+;; No entry has the requested port, but :port is required, so search fails.
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search
+ :host "x.com" :port 22 :require '(:port) :max 2)))
+ (should-not results))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss ()
+ (let ((auth-source-pass-extra-query-keywords t))
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("x.com:42" (secret . "b")))
+ (auth-source-pass-enable)
+ (should-not (auth-source-search
+ :host "x.com" :port 22 :require '(:port) :max 2)))))
+
+;; Specifying a :host without a :user finds a lone entry and does not
+;; include extra fields (i.e., :port nil) in the result.
+;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html
+
+(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine x.com password a
+machine disroot.org user akib password b
+machine z.com password c
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "disroot.org" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "disroot.org" :user "akib" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--akib ()
+ (auth-source-pass--with-store '(("x.com" (secret . "a"))
+ ("akib@disroot.org" (secret . "b"))
+ ("z.com" (secret . "c")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "disroot.org" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "disroot.org" :user "akib" :secret "b")))))))
+
+;; Searches for :host are case-sensitive, and a returned host isn't
+;; normalized.
+
+(ert-deftest auth-source-pass-extra-query-keywords--netrc-host ()
+ (ert-with-temp-file netrc-file
+ :text "\
+machine libera.chat password a
+machine Libera.Chat password b
+"
+ (let* ((auth-sources (list netrc-file))
+ (auth-source-do-cache nil)
+ (results (auth-source-search :host "Libera.Chat" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "Libera.Chat" :secret "b")))))))
+
+(ert-deftest auth-source-pass-extra-query-keywords--host ()
+ (auth-source-pass--with-store '(("libera.chat" (secret . "a"))
+ ("Libera.Chat" (secret . "b")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "Libera.Chat" :max 2)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "Libera.Chat" :secret "b")))))))
+
+
+;; A retrieved store entry mustn't be nil regardless of whether its
+;; path contains port or user components.
+
+(ert-deftest auth-source-pass-extra-query-keywords--baseline ()
+ (let ((auth-source-pass-extra-query-keywords t))
+ (auth-source-pass--with-store '(("x.com"))
+ (auth-source-pass-enable)
+ (should-not (auth-source-search :host "x.com")))))
+
+;; Output port type (int or string) matches that of input parameter.
+
+(ert-deftest auth-source-pass-extra-query-keywords--port-type ()
+ (let ((auth-source-pass-extra-query-keywords t)
+ (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r)))
+ (auth-source-pass--with-store '(("x.com:42" (secret . "a")))
+ (auth-source-pass-enable)
+ (should (equal (mapcar f (auth-source-search :host "x.com" :port 42))
+ '((:host "x.com" :port 42 :secret "a")))))
+ (auth-source-pass--with-store '(("x.com:42" (secret . "a")))
+ (auth-source-pass-enable)
+ (should (equal (mapcar f (auth-source-search :host "x.com" :port "42"))
+ '((:host "x.com" :port "42" :secret "a")))))))
+
+;; Match precision sometimes takes a back seat to the traversal
+;; ordering. Specifically, the :host (h1, ...) args hold greater sway
+;; over the output because they determine the first coordinate in the
+;; sequence of (host, user, port) combinations visited. (Taking a
+;; tree-wise view, these become the depth-1 nodes in a DFS.)
+
+;; Note that all trailing /user forms are demoted for the sake of
+;; predictability (see tests further below for details). This means
+;; that, in the following test, /bar is held in limbo, followed by
+;; /foo, but they both retain priority over "gnu.org", as noted above.
+
+(ert-deftest auth-source-pass-extra-query-keywords--hosts-first ()
+ (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a"))
+ ("gnu.org" (secret . "b"))
+ ("x.com" (secret . "c"))
+ ("fake.com" (secret . "d"))
+ ("x.com/foo" (secret . "e")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host '("x.com" "gnu.org") :max 3)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ ;; Notice gnu.org is never considered ^
+ '((:host "x.com" :secret "c")
+ (:host "x.com" :user "bar" :port "42" :secret "a")
+ (:host "x.com" :user "foo" :secret "e")))))))
+
+;; This is another example given in the bug thread.
+
+(ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host ()
+ (auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a"))
+ ("foo.com" (secret . "b"))
+ ("bar.org" (secret . "c"))
+ ("fake.com" (secret . "d")))
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host "bar.org" :max 3)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results '((:host "bar.org" :secret "c")))))))
+
+;; This conveys the same idea as `user-priorities', just below, but
+;; with slightly more realistic and less legible values.
+
+(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user ()
+ (let ((store (sort (copy-sequence '(("x.com:42/bar" (secret . "a"))
+ ("bar@x.com" (secret . "b"))
+ ("x.com" (secret . "?"))
+ ("bar@y.org" (secret . "c"))
+ ("fake.com" (secret . "?"))
+ ("fake.com/bar" (secret . "d"))
+ ("y.org/bar" (secret . "?"))
+ ("bar@fake.com" (secret . "e"))))
+ (lambda (&rest _) (zerop (random 2))))))
+ (auth-source-pass--with-store store
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host '("x.com" "fake.com" "y.org")
+ :user "bar"
+ :require '(:user) :max 5)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "x.com" :user "bar" :secret "b")
+ (:host "x.com" :user "bar" :port "42" :secret "a")
+ (:host "fake.com" :user "bar" :secret "e")
+ (:host "fake.com" :user "bar" :secret "d")
+ (:host "y.org" :user "bar" :secret "c"))))))))
+
+;; This is a more distilled version of `suffixed-user', above. It
+;; better illustrates that search order takes precedence over "/user"
+;; demotion because otherwise * and ** would be swapped, below. It
+;; follows that omitting the :port 2, gets you {u@h:1, u@h:2, h:1/u,
+;; h:2/u, u@g:1}.
+
+(ert-deftest auth-source-pass-extra-query-keywords--user-priorities ()
+ (let ((store (sort (copy-sequence '(("h:1/u" (secret . "/"))
+ ("h:2/u" (secret . "/"))
+ ("u@h:1" (secret . "@"))
+ ("u@h:2" (secret . "@"))
+ ("g:1/u" (secret . "/"))
+ ("g:2/u" (secret . "/"))
+ ("u@g:1" (secret . "@"))
+ ("u@g:2" (secret . "@"))))
+ (lambda (&rest _) (zerop (random 2))))))
+ (auth-source-pass--with-store store
+ (auth-source-pass-enable)
+ (let* ((auth-source-pass-extra-query-keywords t)
+ (results (auth-source-search :host '("h" "g")
+ :port 2
+ :max 5)))
+ (dolist (result results)
+ (setf (plist-get result :secret) (auth-info-password result)))
+ (should (equal results
+ '((:host "h" :user "u" :port 2 :secret "@")
+ (:host "h" :user "u" :port 2 :secret "/") ; *
+ (:host "g" :user "u" :port 2 :secret "@") ; **
+ (:host "g" :user "u" :port 2 :secret "/"))))))))
+
(provide 'auth-source-pass-tests)
;;; auth-source-pass-tests.el ends here
diff --git a/test/lisp/autorevert-tests.el b/test/lisp/autorevert-tests.el
index 4bbff6d057..568820ec42 100644
--- a/test/lisp/autorevert-tests.el
+++ b/test/lisp/autorevert-tests.el
@@ -507,7 +507,7 @@ This expects `auto-revert--messages' to be bound by
(should (equal (auto-revert-test--buffer-string buf-1) "1-a"))
(auto-revert-test--write-file "1-b" file-1)
;; Since the file is deleted, it needs at least
- ;; `autorevert-interval' to recognize the new file,
+ ;; `auto-revert-interval' to recognize the new file,
;; while polling. So increase the timeout.
(auto-revert-test--wait-for-buffer-text
buf-1 "1-b" (* 2 (auto-revert--timeout)))
diff --git a/test/lisp/calendar/icalendar-tests.el
b/test/lisp/calendar/icalendar-tests.el
index 7f8cd47914..2e9353a09b 100644
--- a/test/lisp/calendar/icalendar-tests.el
+++ b/test/lisp/calendar/icalendar-tests.el
@@ -1310,7 +1310,7 @@ SUMMARY:and diary-anniversary
"import-real-world-2003-05-29.diary-european"
"import-real-world-2003-05-29.diary-american")
- ;; created with http://apps.marudot.com/ical/
+ ;; created with https://apps.marudot.com/ical/
(icalendar-tests--test-import "import-real-world-no-dst.ics"
nil
"import-real-world-no-dst.diary-european"
diff --git a/test/lisp/cedet/semantic-utest.el
b/test/lisp/cedet/semantic-utest.el
index 24a467474b..b577b19808 100644
--- a/test/lisp/cedet/semantic-utest.el
+++ b/test/lisp/cedet/semantic-utest.el
@@ -609,7 +609,6 @@ INSERTME is the text to be inserted after the deletion."
(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 (semantic-utest-fname "csharptest.cs")
semantic-utest-Csharp-buffer-contents semantic-utest-Csharp-name-contents
'("fun2") "//1" "//deleted line")
diff --git a/test/lisp/cedet/srecode/fields-tests.el
b/test/lisp/cedet/srecode/fields-tests.el
index 292ac4e3b5..c9e0d4601b 100644
--- a/test/lisp/cedet/srecode/fields-tests.el
+++ b/test/lisp/cedet/srecode/fields-tests.el
@@ -66,7 +66,7 @@ It is filled with some text."
(when (and (overlayp (oref f overlay))
(not (overlay-get (oref f overlay) 'srecode-init-only)))
- (error "Field creation overlay is not tagged w/ init flag"))
+ (error "Field creation overlay is not tagged with init flag"))
(srecode-overlaid-activate f)
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 09becc7fe7..18b0257e01 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -354,6 +354,17 @@
(should (equal "subdir" (dired-get-filename 'local t)))))))
+(ert-deftest dired-test-bug59047 ()
+ "Test for https://debbugs.gnu.org/59047 ."
+ (dired (list (expand-file-name "src" source-directory)
+ "cygw32.c" "alloc.c" "w32xfns.c" "xdisp.c"))
+ (dired-hide-all)
+ (dired-hide-all)
+ (dired-next-line 1)
+ (should (equal 'dired-hide-details-detail
+ (get-text-property
+ (1+ (line-beginning-position)) 'invisible))))
+
(defmacro dired-test-with-temp-dirs (just-empty-dirs &rest body)
"Helper macro for Bug#27940 test."
(declare (indent 1) (debug body))
diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el
index 67b660fc12..bdadc0f280 100644
--- a/test/lisp/dnd-tests.el
+++ b/test/lisp/dnd-tests.el
@@ -416,7 +416,7 @@ This function only tries to handle strings."
;; system specific test is in x-dnd-tests.el. When running this
;; interactively, keep in mind that there are only two file managers
;; which are known to implement XDS correctly: System G (see
- ;; http://nps-systemg.sourceforge.net), and Emacs itself. GTK file
+ ;; https://nps-systemg.sourceforge.net), and Emacs itself. GTK file
;; managers such as Nautilus will not work, since they prefer the
;; `text/uri-list' selection target to `XdndDirectSave0', contrary
;; to the XDS specification.
diff --git a/test/lisp/elide-head-tests.el b/test/lisp/elide-head-tests.el
index 6f351170f1..429ef26657 100644
--- a/test/lisp/elide-head-tests.el
+++ b/test/lisp/elide-head-tests.el
@@ -3,7 +3,6 @@
;; Copyright (C) 2020-2022 Free Software Foundation, Inc.
;; Author: Simen Heggestøyl <simenheg@gmail.com>
-;; Keywords:
;; This file is part of GNU Emacs.
@@ -20,10 +19,6 @@
;; 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 'elide-head)
@@ -169,6 +164,22 @@
***************************************************************************/
" "This program is distributed in the hope that")
+;; from mentor.el [no "/" in the gnu.org URL]
+(elide-head--add-test gpl3-5 "\
+;; Mentor 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, or (at your option)
+;; any later version.
+;;
+;; Mentor 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 Mentor. If not, see <https://www.gnu.org/licenses>.
+" "Mentor is distributed in the hope that")
+
;;; GPLv2
diff --git a/test/lisp/emacs-lisp/bindat-tests.el
b/test/lisp/emacs-lisp/bindat-tests.el
index 0c03c51e2e..2abf714852 100644
--- a/test/lisp/emacs-lisp/bindat-tests.el
+++ b/test/lisp/emacs-lisp/bindat-tests.el
@@ -252,7 +252,24 @@
(should (equal (bindat-unpack spec "abc\0") "abc"))
;; Missing null terminator.
(should-error (bindat-unpack spec ""))
- (should-error (bindat-unpack spec "a"))))
+ (should-error (bindat-unpack spec "a")))
+
+ (ert-deftest bindat-test--strz-array-unpack ()
+ (should (equal (bindat-unpack spec [#x61 #x62 #x63 #x00]) "abc"))))
+
+(let ((spec (bindat-type str 3)))
+ (ert-deftest bindat-test--str-simple-array-unpack ()
+ (should (equal (bindat-unpack spec [#x61 #x62 #x63]) "abc"))))
+
+(let ((spec (bindat-type
+ (first u8)
+ (string str 3)
+ (last uint 16))))
+ (ert-deftest bindat-test--str-combined-array-unpack ()
+ (let ((unpacked (bindat-unpack spec [#xff #x63 #x62 #x61 #xff #xff])))
+ (should (equal (bindat-get-field unpacked 'string) "cba"))
+ (should (equal (bindat-get-field unpacked 'first) (- (expt 2 8) 1)))
+ (should (equal (bindat-get-field unpacked 'last) (- (expt 2 16) 1))))))
(let ((spec '((x strz 2))))
(ert-deftest bindat-test--strz-legacy-fixedlen-len ()
diff --git a/test/lisp/emacs-lisp/cconv-tests.el
b/test/lisp/emacs-lisp/cconv-tests.el
index 37470f863f..e666fe0a4c 100644
--- a/test/lisp/emacs-lisp/cconv-tests.el
+++ b/test/lisp/emacs-lisp/cconv-tests.el
@@ -351,11 +351,18 @@
(let ((f (let ((d 51695))
(lambda (data)
(interactive (progn (setq d (1+ d)) (list d)))
- (list (called-interactively-p 'any) data)))))
- (should (equal (list (call-interactively f)
- (funcall f 51695)
- (call-interactively f))
- '((t 51696) (nil 51695) (t 51697))))))
+ (list (called-interactively-p 'any) data))))
+ (f-interp
+ (eval '(let ((d 51695))
+ (lambda (data)
+ (interactive (progn (setq d (1+ d)) (list d)))
+ (list (called-interactively-p 'any) data)))
+ t)))
+ (dolist (f (list f f-interp))
+ (should (equal (list (call-interactively f)
+ (funcall f 51695)
+ (call-interactively f))
+ '((t 51696) (nil 51695) (t 51697)))))))
(provide 'cconv-tests)
;;; cconv-tests.el ends here
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el
b/test/lisp/emacs-lisp/cl-extra-tests.el
index 297e413d85..6a34cd681e 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -32,8 +32,28 @@
(ert-deftest cl-getf ()
(let ((plist '(x 1 y nil)))
(should (eq (cl-getf plist 'x) 1))
- (should (eq (cl-getf plist 'y :none) nil))
- (should (eq (cl-getf plist 'z :none) :none))))
+ (should-not (cl-getf plist 'y :none))
+ (should (eq (cl-getf plist 'z :none) :none))
+ (should (eq (cl-incf (cl-getf plist 'x 10) 2) 3))
+ (should (equal plist '(x 3 y nil)))
+ (should-error (cl-incf (cl-getf plist 'y 10) 4) :type 'wrong-type-argument)
+ (should (equal plist '(x 3 y nil)))
+ (should (eq (cl-incf (cl-getf plist 'z 10) 5) 15))
+ (should (equal plist '(z 15 x 3 y nil))))
+ (let ((plist '(x 1 y)))
+ (should (eq (cl-getf plist 'x) 1))
+ (should (eq (cl-getf plist 'y :none) :none))
+ (should (eq (cl-getf plist 'z :none) :none))
+ (should (eq (cl-incf (cl-getf plist 'x 10) 2) 3))
+ (should (equal plist '(x 3 y)))
+ (should (eq (cl-incf (cl-getf plist 'y 10) 4) 14))
+ (should (equal plist '(y 14 x 3 y))))
+ (let ((plist '(x 1 y . 2)))
+ (should (eq (cl-getf plist 'x) 1))
+ (should (eq (cl-incf (cl-getf plist 'x 10) 2) 3))
+ (should (equal plist '(x 3 y . 2)))
+ (should-error (cl-getf plist 'y :none) :type 'wrong-type-argument)
+ (should-error (cl-getf plist 'z :none) :type 'wrong-type-argument)))
(ert-deftest cl-extra-test-mapc ()
(let ((lst '(a b c))
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el
b/test/lisp/emacs-lisp/cl-generic-tests.el
index 56b766769e..8e807b1591 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -297,5 +297,27 @@ Edebug symbols (Bug#42672)."
(intern "cl-defgeneric/edebug/method/2 (number)")
'cl-defgeneric/edebug/method/2))))))
+(cl-defgeneric cl-generic-tests--acc (x &optional y)
+ (declare (advertised-calling-convention (x) "671.2")))
+
+(cl-defmethod cl-generic-tests--acc ((x float)) (+ x 5.0))
+
+(ert-deftest cl-generic-tests--advertised-calling-convention-bug58563 ()
+ (should (equal (get-advertised-calling-convention
+ (indirect-function 'cl-generic-tests--acc))
+ '(x)))
+ (should
+ (condition-case err
+ (let ((lexical-binding t)
+ (byte-compile-debug t)
+ (byte-compile-error-on-warn t))
+ (byte-compile '(cl-defmethod cl-generic-tests--acc ((x list))
+ (declare (advertised-calling-convention (y) "1.1"))
+ (cons x '(5 5 5 5 5))))
+ nil)
+ (error
+ (and (eq 'error (car err))
+ (string-match "Stray.*declare" (cadr err)))))))
+
(provide 'cl-generic-tests)
;;; cl-generic-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 f742637ee3..160ac59113 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -803,4 +803,10 @@ See Bug#57915."
(macroexpand form)
(should (string-empty-p messages))))))))
+(ert-deftest cl-&key-arguments ()
+ (cl-flet ((fn (&key x) x))
+ (should-error (fn :x))
+ (should (eq (fn :x :a) :a))))
+
+
;;; cl-macs-tests.el ends here
diff --git a/test/lisp/emacs-lisp/comp-tests.el
b/test/lisp/emacs-lisp/comp-tests.el
new file mode 100644
index 0000000000..082b641fe3
--- /dev/null
+++ b/test/lisp/emacs-lisp/comp-tests.el
@@ -0,0 +1,77 @@
+;;; comp-tests.el --- Tests for comp.el -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 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 'ert-x)
+(require 'comp)
+
+(defvar comp-native-version-dir)
+(defvar native-comp-eln-load-path)
+
+(defmacro with-test-native-compile-prune-cache (&rest body)
+ (declare (indent 0) (debug t))
+ `(ert-with-temp-directory testdir
+ (setq testdir (expand-file-name "eln-cache" testdir))
+ (make-directory testdir)
+ (let* ((c1 (expand-file-name "29.0.50-cur" testdir))
+ (c2 (expand-file-name "29.0.50-old" testdir))
+ (native-comp-eln-load-path (list testdir))
+ (comp-native-version-dir "29.0.50-cur"))
+ (dolist (d (list c1 c2))
+ (make-directory d)
+ (with-temp-file (expand-file-name "some.eln" d) (insert "foo"))
+ (with-temp-file (expand-file-name "some.eln.tmp" d) (insert "foo")))
+ ,@body)))
+
+(ert-deftest test-native-compile-prune-cache ()
+ (skip-unless (featurep 'native-compile))
+ (with-test-native-compile-prune-cache
+ (native-compile-prune-cache)
+ (should (file-directory-p c1))
+ (should (file-regular-p (expand-file-name "some.eln" c1)))
+ (should (file-regular-p (expand-file-name "some.eln.tmp" c1)))
+ (should-not (file-directory-p c2))
+ (should-not (file-regular-p (expand-file-name "some.eln" c2)))
+ (should-not (file-regular-p (expand-file-name "some.eln.tmp" c2)))))
+
+(ert-deftest test-native-compile-prune-cache/delete-only-eln ()
+ (skip-unless (featurep 'native-compile))
+ (with-test-native-compile-prune-cache
+ (with-temp-file (expand-file-name "keep1.txt" c1) (insert "foo"))
+ (with-temp-file (expand-file-name "keep2.txt" c2) (insert "foo"))
+ (native-compile-prune-cache)
+ (should (file-regular-p (expand-file-name "keep1.txt" c1)))
+ (should (file-regular-p (expand-file-name "keep2.txt" c2)))))
+
+(ert-deftest test-native-compile-prune-cache/dont-delete-in-parent-of-cache ()
+ (skip-unless (featurep 'native-compile))
+ (with-test-native-compile-prune-cache
+ (let ((f1 (expand-file-name "../some.eln" testdir))
+ (f2 (expand-file-name "some.eln" testdir)))
+ (with-temp-file f1 (insert "foo"))
+ (with-temp-file f2 (insert "foo"))
+ (native-compile-prune-cache)
+ (should (file-regular-p f1))
+ (should (file-regular-p f2)))))
+
+;;; comp-tests.el ends here
diff --git a/test/lisp/emacs-lisp/gv-tests.el b/test/lisp/emacs-lisp/gv-tests.el
index 0757e3c7aa..69a7bcf7dd 100644
--- a/test/lisp/emacs-lisp/gv-tests.el
+++ b/test/lisp/emacs-lisp/gv-tests.el
@@ -157,55 +157,42 @@ its getter (Bug#41853)."
(push 123 (gv-setter-edebug-get 'gv-setter-edebug
'gv-setter-edebug-prop))))
(print form (current-buffer)))
- ;; Only check whether evaluation works in general.
- (eval-buffer)))
+ ;; Silence "Edebug: foo" messages.
+ (let ((inhibit-message t))
+ ;; Only check whether evaluation works in general.
+ (eval-buffer))))
(should (equal (get 'gv-setter-edebug 'gv-setter-edebug-prop) '(123))))
(ert-deftest gv-plist-get ()
- (require 'cl-lib)
-
- ;; Simple setf usage for plist-get.
- (should (equal (let ((target '(:a "a" :b "b" :c "c")))
- (setf (plist-get target :b) "modify")
- target)
- '(:a "a" :b "modify" :c "c")))
-
- ;; Other function (cl-rotatef) usage for plist-get.
- (should (equal (let ((target '(:a "a" :b "b" :c "c")))
- (cl-rotatef (plist-get target :b) (plist-get target :c))
- target)
- '(:a "a" :b "c" :c "b")))
-
- ;; Add new key value pair at top of list if setf for missing key.
- (should (equal (let ((target '(:a "a" :b "b" :c "c")))
- (setf (plist-get target :d) "modify")
- target)
- '(:d "modify" :a "a" :b "b" :c "c")))
+ ;; Simple `setf' usage for `plist-get'.
+ (let ((target (list :a "a" :b "b" :c "c")))
+ (setf (plist-get target :b) "modify")
+ (should (equal target '(:a "a" :b "modify" :c "c")))
+ (setf (plist-get target ":a" #'string=) "mogrify")
+ (should (equal target '(:a "mogrify" :b "modify" :c "c"))))
+
+ ;; Other function (`cl-rotatef') usage for `plist-get'.
+ (let ((target (list :a "a" :b "b" :c "c")))
+ (cl-rotatef (plist-get target :b) (plist-get target :c))
+ (should (equal target '(:a "a" :b "c" :c "b")))
+ (cl-rotatef (plist-get target ":a" #'string=)
+ (plist-get target ":b" #'string=))
+ (should (equal target '(:a "c" :b "a" :c "b"))))
+
+ ;; Add new key value pair at top of list if `setf' for missing key.
+ (let ((target (list :a "a" :b "b" :c "c")))
+ (setf (plist-get target :d) "modify")
+ (should (equal target '(:d "modify" :a "a" :b "b" :c "c")))
+ (setf (plist-get target :e #'string=) "mogrify")
+ (should (equal target '(:e "mogrify" :d "modify" :a "a" :b "b" :c "c"))))
;; Rotate with missing value.
;; The value corresponding to the missing key is assumed to be nil.
- (should (equal (let ((target '(:a "a" :b "b" :c "c")))
- (cl-rotatef (plist-get target :b) (plist-get target :d))
- target)
- '(:d "b" :a "a" :b nil :c "c")))
-
- ;; Simple setf usage for plist-get. (symbol plist)
- (should (equal (let ((target '(a "a" b "b" c "c")))
- (setf (plist-get target 'b) "modify")
- target)
- '(a "a" b "modify" c "c")))
-
- ;; Other function (cl-rotatef) usage for plist-get. (symbol plist)
- (should (equal (let ((target '(a "a" b "b" c "c")))
- (cl-rotatef (plist-get target 'b) (plist-get target 'c))
- target)
- '(a "a" b "c" c "b"))))
-
-;; `ert-deftest' messes up macroexpansion when the test file itself is
-;; compiled (see Bug #24402).
-
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+ (let ((target (list :a "a" :b "b" :c "c")))
+ (cl-rotatef (plist-get target :b) (plist-get target :d))
+ (should (equal target '(:d "b" :a "a" :b nil :c "c")))
+ (cl-rotatef (plist-get target ":e" #'string=)
+ (plist-get target ":d" #'string=))
+ (should (equal target '(":e" "b" :d nil :a "a" :b nil :c "c")))))
;;; gv-tests.el ends here
diff --git a/test/lisp/emacs-lisp/hierarchy-tests.el
b/test/lisp/emacs-lisp/hierarchy-tests.el
index 41d3f2f3cc..97a0f7ba52 100644
--- a/test/lisp/emacs-lisp/hierarchy-tests.el
+++ b/test/lisp/emacs-lisp/hierarchy-tests.el
@@ -552,5 +552,148 @@
(hierarchy-sort organisms)
(should (equal (hierarchy-roots organisms) '(animal plant)))))
+(defun hierarchy-examples-delayed--find-number (num)
+ "Find a number, NUM, by adding 1s together until you reach it.
+This is entire contrived and mostly meant to be purposefully inefficient to
+not be possible on a large scale.
+Running the number 200 causes this function to crash; running this function in
+`hierarchy-add-tree' with a root of 80 and no delayed children causes that to
+ crash.
+If generating hierarchy children is not delayed, tests for that functionality
+should fail as this function will crash."
+
+ (funcall (lambda (funct) (funcall funct 1 funct))
+ (lambda (n funct)
+ (if (< n num)
+ (+ 1 (funcall funct (+ 1 n) funct))
+ 1))))
+
+(defun hierarchy-examples-delayed--childrenfn (hier-elem)
+ "Return the children of HIER-ELEM.
+Basially, feed the number, minus 1, to
`hierarchy-examples-delayed--find-number'
+and then create a list of the number plus 0.0–0.9."
+
+ (when (> hier-elem 1)
+ (let ((next (hierarchy-examples-delayed--find-number (1- hier-elem))))
+ (mapcar (lambda (dec) (+ next dec)) '(.0 .1 .2 .3 .4 .5 .6 .7 .8 .9)))))
+
+(ert-deftest hierarchy-delayed-add-one-root ()
+ (let ((parentfn (lambda (_) nil))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(190)))))
+
+(ert-deftest hierarchy-delayed-add-one-item-with-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-one-item-with-parent-and-grand-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191)
+ (191 192))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(192)))
+ (should (equal (hierarchy-children hierarchy 192) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-same-root-twice ()
+ (let ((parentfn (lambda (_) nil))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(190)))))
+
+(ert-deftest hierarchy-delayed-add-same-child-twice ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-item-and-its-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 191 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-item-and-its-child ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 191 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 190) '()))))
+
+(ert-deftest hierarchy-delayed-add-two-items-sharing-parent ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191)
+ (190.5 191))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 190.5 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(191)))
+ (should (equal (hierarchy-children hierarchy 191) '(190 190.5)))))
+
+(ert-deftest hierarchy-delayed-add-two-hierarchies ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 191)
+ (circle 'shape))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-tree hierarchy 190 parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (hierarchy-add-tree hierarchy 'circle parentfn)
+ (should (equal (hierarchy-roots hierarchy) '(191 shape)))
+ (should (equal (hierarchy-children hierarchy 191) '(190)))
+ (should (equal (hierarchy-children hierarchy 'shape) '(circle)))))
+
+(ert-deftest hierarchy-delayed-add-trees ()
+ (let ((parentfn (lambda (item)
+ (cl-case item
+ (190 '191)
+ (190.5 '191)
+ (191 '192))))
+ (hierarchy (hierarchy-new)))
+ (hierarchy-add-trees hierarchy '(190 190.5) parentfn
+ #'hierarchy-examples-delayed--childrenfn nil t)
+ (should (equal (hierarchy-roots hierarchy) '(192)))
+ (should (equal (hierarchy-children hierarchy '192) '(191)))
+ (should (equal (hierarchy-children hierarchy '191) '(190 190.5)))))
+
(provide 'hierarchy-tests)
;;; hierarchy-tests.el ends here
diff --git a/test/lisp/emacs-lisp/map-tests.el
b/test/lisp/emacs-lisp/map-tests.el
index 314a1c9e30..75ebe59431 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -29,10 +29,13 @@
(require 'ert)
(require 'map)
+(eval-when-compile
+ (require 'cl-lib))
+
(defmacro with-maps-do (var &rest body)
"Successively bind VAR to an alist, plist, vector, and hash-table.
Each map is built from the following alist data:
- \\='((0 . 3) (1 . 4) (2 . 5)).
+ ((0 . 3) (1 . 4) (2 . 5))
Evaluate BODY for each created map."
(declare (indent 1) (debug (symbolp body)))
(let ((alist (make-symbol "alist"))
@@ -84,18 +87,96 @@ Evaluate BODY for each created map."
(with-empty-maps-do map
(should (= 5 (map-elt map 0 5)))))
-(ert-deftest test-map-elt-testfn ()
+(ert-deftest test-map-elt-testfn-alist ()
+ "Test the default alist predicate of `map-elt'."
(let* ((a (string ?a))
(map `((,a . 0) (,(string ?b) . 1))))
- (should (= (map-elt map a) 0))
- (should (= (map-elt map "a") 0))
- (should (= (map-elt map (string ?a)) 0))
- (should (= (map-elt map "b") 1))
- (should (= (map-elt map (string ?b)) 1))))
+ (should (= 0 (map-elt map a)))
+ (should (= 0 (map-elt map "a")))
+ (should (= 0 (map-elt map (string ?a))))
+ (should (= 1 (map-elt map "b")))
+ (should (= 1 (map-elt map (string ?b))))
+ (with-suppressed-warnings ((callargs map-elt))
+ (should (= 0 (map-elt map 'a nil #'string=)))
+ (should (= 1 (map-elt map 'b nil #'string=))))))
+
+(ert-deftest test-map-elt-testfn-plist ()
+ "Test the default plist predicate of `map-elt'."
+ (let* ((a (string ?a))
+ (map `(,a 0 "b" 1)))
+ (should-not (map-elt map "a"))
+ (should-not (map-elt map "b"))
+ (should-not (map-elt map (string ?a)))
+ (should-not (map-elt map (string ?b)))
+ (should (= 0 (map-elt map a)))
+ (with-suppressed-warnings ((callargs map-elt))
+ (should (= 0 (map-elt map a nil #'equal)))
+ (should (= 0 (map-elt map "a" nil #'equal)))
+ (should (= 0 (map-elt map (string ?a) nil #'equal)))
+ (should (= 1 (map-elt map "b" nil #'equal)))
+ (should (= 1 (map-elt map (string ?b) nil #'equal))))))
+
+(ert-deftest test-map-elt-gv ()
+ "Test the generalized variable `map-elt'."
+ (let ((sort (lambda (map) (sort (map-pairs map) #'car-less-than-car))))
+ (with-empty-maps-do map
+ ;; Empty map, without default.
+ (should-error (cl-incf (map-elt map 1)) :type 'wrong-type-argument)
+ (with-suppressed-warnings ((callargs map-elt))
+ (should-error (cl-incf (map-elt map 1.0 nil #'=))
+ :type 'wrong-type-argument))
+ (should (map-empty-p map))
+ ;; Empty map, with default.
+ (if (vectorp map)
+ (progn
+ (should-error (cl-incf (map-elt map 1 3)) :type 'args-out-of-range)
+ (with-suppressed-warnings ((callargs map-elt))
+ (should-error (cl-incf (map-elt map 1 3 #'=))
+ :type 'args-out-of-range))
+ (should (map-empty-p map)))
+ (should (= (cl-incf (map-elt map 1 3) 10) 13))
+ (with-suppressed-warnings ((callargs map-elt))
+ (should (= (cl-incf (map-elt map 2.0 5 #'=) 12) 17)))
+ (should (equal (funcall sort map) '((1 . 13) (2.0 . 17))))))
+ (with-maps-do map
+ ;; Nonempty map, without predicate.
+ (should (= (cl-incf (map-elt map 1 3) 10) 14))
+ (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 5))))
+ ;; Nonempty map, with predicate.
+ (with-suppressed-warnings ((callargs map-elt))
+ (pcase-exhaustive map
+ ((pred consp)
+ (should (= (cl-incf (map-elt map 2.0 6 #'=) 12) 17))
+ (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 17))))
+ (should (= (cl-incf (map-elt map 0 7 #'=) 13) 16))
+ (should (equal (funcall sort map) '((0 . 16) (1 . 14) (2 . 17)))))
+ ((pred vectorp)
+ (should-error (cl-incf (map-elt map 2.0 6 #'=))
+ :type 'wrong-type-argument)
+ (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 5))))
+ (should (= (cl-incf (map-elt map 2 6 #'=) 12) 17))
+ (should (equal (funcall sort map) '((0 . 3) (1 . 14) (2 . 17))))
+ (should (= (cl-incf (map-elt map 0 7 #'=) 13) 16))
+ (should (equal (funcall sort map) '((0 . 16) (1 . 14) (2 . 17)))))
+ ((pred hash-table-p)
+ (should (= (cl-incf (map-elt map 2.0 6 #'=) 12) 18))
+ (should (member (funcall sort map)
+ '(((0 . 3) (1 . 14) (2 . 5) (2.0 . 18))
+ ((0 . 3) (1 . 14) (2.0 . 18) (2 . 5)))))
+ (should (= (cl-incf (map-elt map 0 7 #'=) 13) 16))
+ (should (member (funcall sort map)
+ '(((0 . 16) (1 . 14) (2 . 5) (2.0 . 18))
+ ((0 . 16) (1 . 14) (2.0 . 18) (2 . 5)))))))))))
(ert-deftest test-map-elt-with-nil-value ()
(should-not (map-elt '((a . 1) (b)) 'b 2)))
+(ert-deftest test-map-elt-signature ()
+ "Test that `map-elt' has the right advertised signature.
+See bug#58531#25 and bug#58563."
+ (should (equal (get-advertised-calling-convention (symbol-function 'map-elt))
+ '(map key &optional default))))
+
(ert-deftest test-map-put! ()
(with-maps-do map
(setf (map-elt map 2) 'hello)
@@ -144,6 +225,24 @@ Evaluate BODY for each created map."
(should (equal map '(("a" . 1))))
(should-error (map-put! map (string ?a) val #'eq) :type 'map-not-inplace)))
+(ert-deftest test-map-put!-plist ()
+ "Test `map-put!' predicate on plists."
+ (let* ((a (string ?a))
+ (map (list a 0)))
+ (map-put! map a -1)
+ (should (equal map '("a" -1)))
+ (map-put! map 'a 2)
+ (should (equal map '("a" -1 a 2)))
+ (with-suppressed-warnings ((callargs map-put!))
+ (map-put! map 'a -3 #'string=))
+ (should (equal map '("a" -3 a 2)))))
+
+(ert-deftest test-map-put!-signature ()
+ "Test that `map-put!' has the right advertised signature.
+See bug#58531#25 and bug#58563."
+ (should (equal (get-advertised-calling-convention (symbol-function
'map-put!))
+ '(map key value))))
+
(ert-deftest test-map-put-alist-new-key ()
"Regression test for Bug#23105."
(let ((alist (list (cons 0 'a))))
@@ -395,13 +494,23 @@ Evaluate BODY for each created map."
(alist '(("a" . 1) (a . 2))))
(should (map-contains-key alist 'a))
(should (map-contains-key plist 'a))
+ ;; FIXME: Why is no warning emitted for these (bug#58563#13)?
(should (map-contains-key alist 'a #'eq))
(should (map-contains-key plist 'a #'eq))
(should (map-contains-key alist key))
+ (should (map-contains-key alist "a"))
+ (should (map-contains-key plist (string ?a) #'equal))
(should-not (map-contains-key plist key))
(should-not (map-contains-key alist key #'eq))
(should-not (map-contains-key plist key #'eq))))
+(ert-deftest test-map-contains-key-signature ()
+ "Test that `map-contains-key' has the right advertised signature.
+See bug#58531#25 and bug#58563."
+ (should (equal (get-advertised-calling-convention
+ (symbol-function 'map-contains-key))
+ '(map key))))
+
(ert-deftest test-map-some ()
(with-maps-do map
(should (eq (map-some (lambda (k _v) (and (= k 1) 'found)) map)
@@ -515,19 +624,19 @@ Evaluate BODY for each created map."
(should (equal alist '((key . value))))))
(ert-deftest test-map-setf-alist-overwrite-key ()
- (let ((alist '((key . value1))))
+ (let ((alist (list (cons 'key 'value1))))
(should (equal (setf (map-elt alist 'key) 'value2)
'value2))
(should (equal alist '((key . value2))))))
(ert-deftest test-map-setf-plist-insert-key ()
- (let ((plist '(key value)))
+ (let ((plist (list 'key 'value)))
(should (equal (setf (map-elt plist 'key2) 'value2)
'value2))
(should (equal plist '(key value key2 value2)))))
(ert-deftest test-map-setf-plist-overwrite-key ()
- (let ((plist '(key value)))
+ (let ((plist (list 'key 'value)))
(should (equal (setf (map-elt plist 'key) 'value2)
'value2))
(should (equal plist '(key value2)))))
@@ -535,14 +644,14 @@ Evaluate BODY for each created map."
(ert-deftest test-hash-table-setf-insert-key ()
(let ((ht (make-hash-table)))
(should (equal (setf (map-elt ht 'key) 'value)
- 'value))
+ 'value))
(should (equal (map-elt ht 'key) 'value))))
(ert-deftest test-hash-table-setf-overwrite-key ()
(let ((ht (make-hash-table)))
(puthash 'key 'value1 ht)
(should (equal (setf (map-elt ht 'key) 'value2)
- 'value2))
+ 'value2))
(should (equal (map-elt ht 'key) 'value2))))
(ert-deftest test-setf-map-with-function ()
@@ -551,8 +660,79 @@ Evaluate BODY for each created map."
(setf (map-elt map 'foo)
(funcall (lambda ()
(cl-incf num))))
+ (should (equal map '((foo . 1))))
;; Check that the function is only called once.
(should (= num 1))))
+(ert-deftest test-map-plist-member ()
+ "Test `map--plist-member' and `map--plist-member-1'."
+ (dolist (mem '(map--plist-member map--plist-member-1))
+ ;; Lambda exercises Lisp implementation.
+ (dolist (= `(nil ,(lambda (a b) (eq a b))))
+ (should-not (funcall mem () 'a =))
+ (should-not (funcall mem '(a) 'b =))
+ (should-not (funcall mem '(a 1) 'b =))
+ (should (equal (funcall mem '(a) 'a =) '(a)))
+ (should (equal (funcall mem '(a . 1) 'a =) '(a . 1)))
+ (should (equal (funcall mem '(a 1 . b) 'a =) '(a 1 . b)))
+ (should (equal (funcall mem '(a 1 b) 'a =) '(a 1 b)))
+ (should (equal (funcall mem '(a 1 b) 'b =) '(b)))
+ (should (equal (funcall mem '(a 1 b . 2) 'a =) '(a 1 b . 2)))
+ (should (equal (funcall mem '(a 1 b . 2) 'b =) '(b . 2)))
+ (should (equal (funcall mem '(a 1 b 2) 'a =) '(a 1 b 2)))
+ (should (equal (funcall mem '(a 1 b 2) 'b =) '(b 2)))
+ (should (equal (should-error (funcall mem '(a . 1) 'b =))
+ '(wrong-type-argument plistp (a . 1))))
+ (should (equal (should-error (funcall mem '(a 1 . b) 'b =))
+ '(wrong-type-argument plistp (a 1 . b)))))
+ (should (equal (funcall mem '(a 1 b 2) "a" #'string=) '(a 1 b 2)))
+ (should (equal (funcall mem '(a 1 b 2) "b" #'string=) '(b 2)))))
+
+(ert-deftest test-map-plist-put ()
+ "Test `map--plist-put' and `map--plist-put-1'."
+ (dolist (put '(map--plist-put map--plist-put-1))
+ ;; Lambda exercises Lisp implementation.
+ (dolist (= `(nil ,(lambda (a b) (eq a b))))
+ (let ((l ()))
+ (should (equal (funcall put l 'a 1 =) '(a 1)))
+ (should-not l))
+ (let ((l (list 'a)))
+ (dolist (key '(a b))
+ (should (equal (should-error (funcall put l key 1 =))
+ '(wrong-type-argument plistp (a)))))
+ (should (equal l '(a))))
+ (let ((l (cons 'a 1)))
+ (dolist (key '(a b))
+ (should (equal (should-error (funcall put l key 1 =))
+ '(wrong-type-argument plistp (a . 1)))))
+ (should (equal l '(a . 1))))
+ (let ((l (cons 'a (cons 1 'b))))
+ (should (equal (funcall put l 'a 2 =) '(a 2 . b)))
+ (dolist (key '(b c))
+ (should (equal (should-error (funcall put l key 3 =))
+ '(wrong-type-argument plistp (a 2 . b)))))
+ (should (equal l '(a 2 . b))))
+ (let ((l (list 'a 1 'b)))
+ (should (equal (funcall put l 'a 2 =) '(a 2 b)))
+ (dolist (key '(b c))
+ (should (equal (should-error (funcall put l key 3 =))
+ '(wrong-type-argument plistp (a 2 b)))))
+ (should (equal l '(a 2 b))))
+ (let ((l (cons 'a (cons 1 (cons 'b 2)))))
+ (should (equal (funcall put l 'a 3 =) '(a 3 b . 2)))
+ (dolist (key '(b c))
+ (should (equal (should-error (funcall put l key 4 =))
+ '(wrong-type-argument plistp (a 3 b . 2)))))
+ (should (equal l '(a 3 b . 2))))
+ (let ((l (list 'a 1 'b 2)))
+ (should (equal (funcall put l 'a 3 =) '(a 3 b 2)))
+ (should (equal (funcall put l 'b 4 =) '(a 3 b 4)))
+ (should (equal (funcall put l 'c 5 =) '(a 3 b 4 c 5)))
+ (should (equal l '(a 3 b 4 c 5)))))
+ (let ((l (list 'a 1 'b 2)))
+ (should (equal (funcall put l "a" 3 #'string=) '(a 3 b 2)))
+ (should (equal (funcall put l "b" 4 #'string=) '(a 3 b 4)))
+ (should (equal (funcall put l "c" 5 #'string=) '(a 3 b 4 "c" 5))))))
+
(provide 'map-tests)
;;; map-tests.el ends here
diff --git a/test/lisp/emacs-lisp/package-resources/elpa-packages.eld
b/test/lisp/emacs-lisp/package-resources/elpa-packages.eld
new file mode 100644
index 0000000000..7884aac278
--- /dev/null
+++ b/test/lisp/emacs-lisp/package-resources/elpa-packages.eld
@@ -0,0 +1,3 @@
+;; Dummy elpa-package.eld
+
+(() :version 1)
diff --git
a/test/lisp/emacs-lisp/package-resources/newer-versions/elpa-packages.eld
b/test/lisp/emacs-lisp/package-resources/newer-versions/elpa-packages.eld
new file mode 100644
index 0000000000..7884aac278
--- /dev/null
+++ b/test/lisp/emacs-lisp/package-resources/newer-versions/elpa-packages.eld
@@ -0,0 +1,3 @@
+;; Dummy elpa-package.eld
+
+(() :version 1)
diff --git a/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld
b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld
new file mode 100644
index 0000000000..7884aac278
--- /dev/null
+++ b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld
@@ -0,0 +1,3 @@
+;; Dummy elpa-package.eld
+
+(() :version 1)
diff --git
a/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld.sig
b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld.sig
new file mode 100644
index 0000000000..39202ca75e
Binary files /dev/null and
b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld.sig differ
diff --git a/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
index 30e74156c0..ddd96748ec 100755
--- a/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
+++ b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh
@@ -30,4 +30,5 @@ rm $KEYRING
#$GPG --export-secret-keys -armor > "../key.sec"
$GPG --import ../key.sec
$GPG --detach-sign --sign "./archive-contents"
+$GPG --detach-sign --sign "./elpa-packages.eld"
$GPG --detach-sign --sign "./signed-good-1.0.el"
diff --git a/test/lisp/emacs-lisp/package-resources/ustar-withsub-0.1.tar
b/test/lisp/emacs-lisp/package-resources/ustar-withsub-0.1.tar
new file mode 100644
index 0000000000..009c4fc420
Binary files /dev/null and
b/test/lisp/emacs-lisp/package-resources/ustar-withsub-0.1.tar differ
diff --git a/test/lisp/emacs-lisp/package-resources/v7-withsub-0.1.tar
b/test/lisp/emacs-lisp/package-resources/v7-withsub-0.1.tar
new file mode 100644
index 0000000000..16c79e529f
Binary files /dev/null and
b/test/lisp/emacs-lisp/package-resources/v7-withsub-0.1.tar differ
diff --git
a/test/lisp/emacs-lisp/package-resources/with-nil-entry/elpa-packages.eld
b/test/lisp/emacs-lisp/package-resources/with-nil-entry/elpa-packages.eld
new file mode 100644
index 0000000000..7884aac278
--- /dev/null
+++ b/test/lisp/emacs-lisp/package-resources/with-nil-entry/elpa-packages.eld
@@ -0,0 +1,3 @@
+;; Dummy elpa-package.eld
+
+(() :version 1)
diff --git a/test/lisp/emacs-lisp/package-tests.el
b/test/lisp/emacs-lisp/package-tests.el
index b903cd781b..ffe4d7cd5f 100644
--- a/test/lisp/emacs-lisp/package-tests.el
+++ b/test/lisp/emacs-lisp/package-tests.el
@@ -275,11 +275,31 @@ Must called from within a `tar-mode' buffer."
(let* ((pkg-el "multi-file-0.2.3.tar")
(source-file (expand-file-name pkg-el (ert-resource-directory))))
- (package-initialize)
(should-not (package-installed-p 'multie-file))
(package-install-file source-file)
(should (package-installed-p 'multi-file))
- (package-delete (cadr (assq 'multi-file package-alist))))
+ (package-delete (cadr (assq 'multi-file package-alist))))))
+
+(ert-deftest package-test-bug58367 ()
+ "Check variations in tarball formats."
+ (with-package-test (:basedir (ert-resource-directory))
+ (package-initialize)
+
+ ;; A package whose first entry is the main dir but without trailing /.
+ (let* ((pkg-el "ustar-withsub-0.1.tar")
+ (source-file (expand-file-name pkg-el (ert-resource-directory))))
+ (should-not (package-installed-p 'ustar-withsub))
+ (package-install-file source-file)
+ (should (package-installed-p 'ustar-withsub))
+ (package-delete (cadr (assq 'ustar-withsub package-alist))))
+
+ ;; A package whose first entry is a file in a subdir.
+ (let* ((pkg-el "v7-withsub-0.1.tar")
+ (source-file (expand-file-name pkg-el (ert-resource-directory))))
+ (should-not (package-installed-p 'v7-withsub))
+ (package-install-file source-file)
+ (should (package-installed-p 'v7-withsub))
+ (package-delete (cadr (assq 'v7-withsub package-alist))))
))
(ert-deftest package-test-install-file-EOLs ()
diff --git a/test/lisp/emacs-lisp/syntax-tests.el
b/test/lisp/emacs-lisp/syntax-tests.el
index f266db5c70..d8fc5c4fa8 100644
--- a/test/lisp/emacs-lisp/syntax-tests.el
+++ b/test/lisp/emacs-lisp/syntax-tests.el
@@ -56,7 +56,7 @@
"\\(?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.
+ ;; shift would result in \10 or more, an error must be signaled.
(should-error
(syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\3" 7)))
diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el
index a1dfbab9dc..74cbb7d947 100644
--- a/test/lisp/erc/erc-dcc-tests.el
+++ b/test/lisp/erc/erc-dcc-tests.el
@@ -20,8 +20,9 @@
;;; Commentary:
;;; Code:
-(require 'ert)
+(require 'ert-x)
(require 'erc-dcc)
+(require 'erc-pcomplete)
(ert-deftest erc-dcc-ctcp-query-send-regexp ()
(let ((s "DCC SEND \"file name\" 2130706433 9899 1405135128"))
@@ -164,4 +165,121 @@
(should (eq t (plist-get (car erc-dcc-list) :turbo)))
(should (equal (pop calls) (list elt "foo.bin" proc))))))))
+(defun erc-dcc-tests--pcomplete-common (test-fn)
+ (with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*")
+ (let* ((inhibit-message noninteractive)
+ (proc (start-process "fake" (current-buffer) "sleep" "10"))
+ (elt (list :nick "tester!~tester@fake.irc"
+ :type 'GET
+ :peer nil
+ :parent proc
+ :ip "127.0.0.1"
+ :port "9899"
+ :file "foo.bin"
+ :size 1405135128))
+ ;;
+ erc-accidental-paste-threshold-seconds
+ erc-insert-modify-hook erc-send-completed-hook
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook)
+ (erc-mode)
+ (pcomplete-erc-setup)
+ (add-hook 'erc-complete-functions #'erc-pcompletions-at-point 0 t)
+ (setq erc-server-process proc
+ erc-input-marker (make-marker)
+ erc-insert-marker (make-marker)
+ erc-server-current-nick "dummy")
+ (setq-local erc-dcc-list (list elt)) ; for interactive noodling
+ (set-process-query-on-exit-flag proc nil)
+ (goto-char (point-max))
+ (set-marker erc-insert-marker (point-max))
+ (erc-display-prompt)
+ (goto-char erc-input-marker)
+ (funcall test-fn))
+ (when noninteractive
+ (kill-buffer))))
+
+(ert-deftest pcomplete/erc-mode/DCC--get-basic ()
+ (erc-dcc-tests--pcomplete-common
+ (lambda ()
+ (insert "/dcc get ")
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get tester" nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get tester foo.bin" nil t))))))
+
+(ert-deftest pcomplete/erc-mode/DCC--get-1flag ()
+ (erc-dcc-tests--pcomplete-common
+ (lambda ()
+ (goto-char erc-input-marker)
+ (delete-region (point) (point-max))
+ (insert "/dcc get -")
+ (call-interactively #'completion-at-point)
+ (with-current-buffer (get-buffer "*Completions*")
+ (goto-char (point-min))
+ (search-forward "-s")
+ (search-forward "-t"))
+ (insert "s ")
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -s tester" nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -s tester foo.bin" nil t))))))
+
+(ert-deftest pcomplete/erc-mode/DCC--get-2flags ()
+ (erc-dcc-tests--pcomplete-common
+ (lambda ()
+ (goto-char erc-input-marker)
+ (delete-region (point) (point-max))
+ (insert "/dcc get -")
+ (call-interactively #'completion-at-point)
+ (with-current-buffer (get-buffer "*Completions*")
+ (goto-char (point-min))
+ (search-forward "-s")
+ (search-forward "-t"))
+ (insert "s -")
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -s -t " nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -s -t tester" nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -s -t tester foo.bin" nil t))))))
+
+(ert-deftest pcomplete/erc-mode/DCC--get-2flags-reverse ()
+ (erc-dcc-tests--pcomplete-common
+ (lambda ()
+ (goto-char erc-input-marker)
+ (delete-region (point) (point-max))
+ (insert "/dcc get -")
+ (call-interactively #'completion-at-point)
+ (with-current-buffer (get-buffer "*Completions*")
+ (goto-char (point-min))
+ (search-forward "-s")
+ (search-forward "-t"))
+ (insert "t -")
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -t -s " nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -t -s tester" nil t)))
+ (call-interactively #'completion-at-point)
+ (save-excursion
+ (beginning-of-line)
+ (should (search-forward "/dcc get -t -s tester foo.bin" nil t))))))
+
;;; erc-dcc-tests.el ends here
diff --git a/test/lisp/erc/erc-networks-tests.el
b/test/lisp/erc/erc-networks-tests.el
index 66a334b709..fc12bf7ce3 100644
--- a/test/lisp/erc/erc-networks-tests.el
+++ b/test/lisp/erc/erc-networks-tests.el
@@ -20,7 +20,7 @@
;;; Code:
(require 'ert-x) ; cl-lib
-(require 'erc-networks)
+(require 'erc)
(defun erc-networks-tests--create-dead-proc (&optional buf)
(let ((p (start-process "true" (or buf (current-buffer)) "true")))
@@ -1704,4 +1704,21 @@
(erc-networks-tests--clean-bufs))
+(ert-deftest erc-networks--determine ()
+ (should (eq (erc-networks--determine "irc.libera.chat") 'Libera.Chat))
+ (should (eq (erc-networks--determine "irc.oftc.net") 'OFTC))
+ (should (eq (erc-networks--determine "irc.dal.net") 'DALnet))
+
+ (let ((erc-server-announced-name "zirconium.libera.chat"))
+ (should (eq (erc-networks--determine) 'Libera.Chat)))
+ (let ((erc-server-announced-name "weber.oftc.net"))
+ (should (eq (erc-networks--determine) 'OFTC)))
+ (let ((erc-server-announced-name "redemption.ix.us.dal.net"))
+ (should (eq (erc-networks--determine) 'DALnet)))
+
+ ;; Failure
+ (let ((erc-server-announced-name "irc-us2.alphachat.net"))
+ (should (eq (erc-networks--determine)
+ erc-networks--name-missing-sentinel))))
+
;;; erc-networks-tests.el ends here
diff --git a/test/lisp/erc/erc-scenarios-base-reconnect.el
b/test/lisp/erc/erc-scenarios-base-reconnect.el
index 49298dc594..8762f33b30 100644
--- a/test/lisp/erc/erc-scenarios-base-reconnect.el
+++ b/test/lisp/erc/erc-scenarios-base-reconnect.el
@@ -224,4 +224,50 @@
(with-current-buffer "#chan"
(funcall expect 10 "here comes the lady")))))
+
+(ert-deftest erc-scenarios-base-cancel-reconnect ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "base/reconnect")
+ (dumb-server (erc-d-run "localhost" t 'timer 'timer 'timer-last))
+ (port (process-contact dumb-server :service))
+ (expect (erc-d-t-make-expecter))
+ (erc-server-auto-reconnect t)
+ erc-autojoin-channels-alist
+ erc-server-buffer)
+
+ (ert-info ("Connect to foonet")
+ (setq erc-server-buffer (erc :server "127.0.0.1"
+ :port port
+ :nick "tester"
+ :password "changeme"
+ :full-name "tester"))
+ (with-current-buffer erc-server-buffer
+ (should (string= (buffer-name) (format "127.0.0.1:%d" port)))))
+
+ (ert-info ("Two connection attempts, all stymied")
+ (with-current-buffer erc-server-buffer
+ (ert-info ("First two attempts behave normally")
+ (dotimes (n 2)
+ (ert-info ((format "Initial attempt %d" (1+ n)))
+ (funcall expect 3 "Opening connection")
+ (funcall expect 2 "Password incorrect")
+ (funcall expect 2 "Connection failed!")
+ (funcall expect 2 "Re-establishing connection"))))
+ (ert-info ("/RECONNECT cancels timer but still attempts to connect")
+ (erc-cmd-RECONNECT)
+ (funcall expect 2 "Canceled")
+ (funcall expect 3 "Opening connection")
+ (funcall expect 2 "Password incorrect")
+ (funcall expect 2 "Connection failed!")
+ (funcall expect 2 "Re-establishing connection"))
+ (ert-info ("Explicitly cancel timer")
+ (erc-cmd-RECONNECT "cancel")
+ (funcall expect 2 "Canceled")
+ (erc-d-t-absent-for 1 "Opening connection" (point)))))
+
+ (ert-info ("Server buffer is unique and temp name is absent")
+ (should (equal (list (get-buffer (format "127.0.0.1:%d" port)))
+ (erc-scenarios-common-buflist "127.0.0.1"))))))
+
;;; erc-scenarios-base-reconnect.el ends here
diff --git a/test/lisp/erc/erc-scenarios-misc.el
b/test/lisp/erc/erc-scenarios-misc.el
index ded620ccc1..8557a77906 100644
--- a/test/lisp/erc/erc-scenarios-misc.el
+++ b/test/lisp/erc/erc-scenarios-misc.el
@@ -177,4 +177,32 @@
(erc-scenarios-common-say "Hi")
(funcall expect 10 "Hola")))))
+(defvar url-irc-function)
+
+(ert-deftest erc-scenarios-handle-irc-url ()
+ :tags '(:expensive-test)
+ (erc-scenarios-common-with-cleanup
+ ((erc-scenarios-common-dialog "join/legacy")
+ (dumb-server (erc-d-run "localhost" t 'foonet))
+ (port (process-contact dumb-server :service))
+ (expect (erc-d-t-make-expecter))
+ (url-irc-function 'url-irc-erc)
+ (erc-url-connect-function
+ (lambda (scheme &rest r)
+ (ert-info ("Connect to foonet")
+ (should (equal scheme "irc"))
+ (with-current-buffer (apply #'erc `(:full-name "tester" ,@r))
+ (should (string= (buffer-name)
+ (format "127.0.0.1:%d" port)))
+ (current-buffer))))))
+
+ (with-temp-buffer
+ (insert (format ";; irc://tester:changeme@127.0.0.1:%d/#chan" port))
+ (goto-char 10)
+ (browse-url-at-point))
+
+ (ert-info ("Connected")
+ (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan"))
+ (funcall expect 10 "welcome")))))
+
;;; erc-scenarios-misc.el ends here
diff --git a/test/lisp/erc/erc-services-tests.el
b/test/lisp/erc/erc-services-tests.el
index 8e2b8d2927..7ff2e36e77 100644
--- a/test/lisp/erc/erc-services-tests.el
+++ b/test/lisp/erc/erc-services-tests.el
@@ -469,15 +469,11 @@
(list (assoc 'secret (cdr found)))))
(defvar erc-join-tests--auth-source-pass-entries
- '(("irc.gnu.org:irc/#chan"
- ("port" . "irc") ("user" . "#chan") (secret . "bar"))
- ("my.gnu.org:irc/#chan"
- ("port" . "irc") ("user" . "#chan") (secret . "baz"))
- ("GNU.chat:irc/#chan"
- ("port" . "irc") ("user" . "#chan") (secret . "foo"))))
+ '(("irc.gnu.org:irc/#chan" (secret . "bar"))
+ ("my.gnu.org:irc/#chan" (secret . "baz"))
+ ("GNU.chat:irc/#chan" (secret . "foo"))))
(ert-deftest erc--auth-source-search--pass-standard ()
- (ert-skip "Pass backend not yet supported")
(let ((store erc-join-tests--auth-source-pass-entries)
(auth-sources '(password-store))
(auth-source-do-cache nil))
@@ -490,7 +486,6 @@
(erc-services-tests--auth-source-standard #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--pass-announced ()
- (ert-skip "Pass backend not yet supported")
(let ((store erc-join-tests--auth-source-pass-entries)
(auth-sources '(password-store))
(auth-source-do-cache nil))
@@ -503,19 +498,13 @@
(erc-services-tests--auth-source-announced #'erc-auth-source-search))))
(ert-deftest erc--auth-source-search--pass-overrides ()
- (ert-skip "Pass backend not yet supported")
(let ((store
`(,@erc-join-tests--auth-source-pass-entries
- ("GNU.chat:6697/#chan"
- ("port" . "6697") ("user" . "#chan") (secret . "spam"))
- ("my.gnu.org:irc/#fsf"
- ("port" . "irc") ("user" . "#fsf") (secret . "42"))
- ("irc.gnu.org:6667"
- ("port" . "6667") (secret . "sesame"))
- ("MyHost:irc"
- ("port" . "irc") (secret . "456"))
- ("MyHost:6667"
- ("port" . "6667") (secret . "123"))))
+ ("GNU.chat:6697/#chan" (secret . "spam"))
+ ("my.gnu.org:irc/#fsf" (secret . "42"))
+ ("irc.gnu.org:6667" (secret . "sesame"))
+ ("MyHost:irc" (secret . "456"))
+ ("MyHost:6667" (secret . "123"))))
(auth-sources '(password-store))
(auth-source-do-cache nil))
diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el
index b2ed29e80e..ff5d802697 100644
--- a/test/lisp/erc/erc-tests.el
+++ b/test/lisp/erc/erc-tests.el
@@ -24,7 +24,6 @@
(require 'ert-x)
(require 'erc)
(require 'erc-ring)
-(require 'erc-networks)
(ert-deftest erc--read-time-period ()
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "")))
@@ -48,27 +47,6 @@
(cl-letf (((symbol-function 'read-string) (lambda (&rest _) "1d")))
(should (equal (erc--read-time-period "foo: ") 86400))))
-(ert-deftest erc--meta--backend-dependencies ()
- (with-temp-buffer
- (insert-file-contents-literally
- (concat (file-name-sans-extension (symbol-file 'erc)) ".el"))
- (let ((beg (search-forward ";; Defined in erc-backend"))
- (end (search-forward "\n\n"))
- vars)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (with-syntax-table lisp-data-mode-syntax-table
- (condition-case _
- (while (push (cadr (read (current-buffer))) vars))
- (end-of-file)))))
- (should (= (point) end))
- (dolist (var vars)
- (setq var (concat "\\_<" (symbol-name var) "\\_>"))
- (ert-info (var)
- (should (save-excursion (search-forward-regexp var nil t))))))))
-
(ert-deftest erc-with-all-buffers-of-server ()
(let (proc-exnet
proc-onet
@@ -975,4 +953,229 @@
(kill-buffer "ExampleNet")
(kill-buffer "#chan")))
+(defvar erc-tests--ipv6-examples
+ '("1:2:3:4:5:6:7:8"
+ "::ffff:10.0.0.1" "::ffff:1.2.3.4" "::ffff:0.0.0.0"
+ "1:2:3:4:5:6:77:88" "::ffff:255.255.255.255"
+ "fe08::7:8" "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff"
+ "1:2:3:4:5:6:7:8" "1::" "1:2:3:4:5:6:7::" "1::8"
+ "1:2:3:4:5:6::8" "1:2:3:4:5:6::8" "1::7:8" "1:2:3:4:5::7:8"
+ "1:2:3:4:5::8" "1::6:7:8" "1:2:3:4::6:7:8" "1:2:3:4::8"
+ "1::5:6:7:8" "1:2:3::5:6:7:8" "1:2:3::8" "1::4:5:6:7:8"
+ "1:2::4:5:6:7:8" "1:2::8" "1::3:4:5:6:7:8" "1::3:4:5:6:7:8"
+ "1::8" "::2:3:4:5:6:7:8" "::2:3:4:5:6:7:8" "::8"
+ "::" "fe08::7:8%eth0" "fe08::7:8%1" "::255.255.255.255"
+ "::ffff:255.255.255.255" "::ffff:0:255.255.255.255"
+ "2001:db8:3:4::192.0.2.33" "64:ff9b::192.0.2.33"))
+
+(ert-deftest erc--server-connect-dumb-ipv6-regexp ()
+ (dolist (a erc-tests--ipv6-examples)
+ (should-not (string-match erc--server-connect-dumb-ipv6-regexp a))
+ (should (string-match erc--server-connect-dumb-ipv6-regexp
+ (concat "[" a "]")))))
+
+(ert-deftest erc-select-read-args ()
+
+ (ert-info ("Defaults to TLS")
+ (should (equal (ert-simulate-keys "\r\r\r\r"
+ (erc-select-read-args))
+ (list :server "irc.libera.chat"
+ :port 6697
+ :nick (user-login-name)
+ :password nil))))
+
+ (ert-info ("Override default TLS")
+ (should (equal (ert-simulate-keys "irc://irc.libera.chat\r\r\r\r"
+ (erc-select-read-args))
+ (list :server "irc.libera.chat"
+ :port 6667
+ :nick (user-login-name)
+ :password nil))))
+
+ (ert-info ("Address includes port")
+ (should (equal (ert-simulate-keys
+ "localhost:6667\rnick\r\r"
+ (erc-select-read-args))
+ (list :server "localhost"
+ :port 6667
+ :nick "nick"
+ :password nil))))
+
+ (ert-info ("Address includes nick, password skipped via option")
+ (should (equal (ert-simulate-keys "nick@localhost:6667\r"
+ (let (erc-prompt-for-password)
+ (erc-select-read-args)))
+ (list :server "localhost"
+ :port 6667
+ :nick "nick"
+ :password nil))))
+
+ (ert-info ("Address includes nick and password")
+ (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r"
+ (erc-select-read-args))
+ (list :server "localhost"
+ :port 6667
+ :nick "nick"
+ :password "sesame"))))
+
+ (ert-info ("IPv6 address plain")
+ (should (equal (ert-simulate-keys "::1\r\r\r\r"
+ (erc-select-read-args))
+ (list :server "[::1]"
+ :port 6667
+ :nick (user-login-name)
+ :password nil))))
+
+ (ert-info ("IPv6 address with port")
+ (should (equal (ert-simulate-keys "[::1]:6667\r\r\r"
+ (erc-select-read-args))
+ (list :server "[::1]"
+ :port 6667
+ :nick (user-login-name)
+ :password nil))))
+
+ (ert-info ("IPv6 address includes nick")
+ (should (equal (ert-simulate-keys "nick@[::1]:6667\r\r"
+ (erc-select-read-args))
+ (list :server "[::1]"
+ :port 6667
+ :nick "nick"
+ :password nil)))))
+
+(ert-deftest erc-tls ()
+ (let (calls)
+ (cl-letf (((symbol-function 'user-login-name)
+ (lambda (&optional _) "tester"))
+ ((symbol-function 'erc-open)
+ (lambda (&rest r) (push r calls))))
+
+ (ert-info ("Defaults")
+ (erc-tls)
+ (should (equal (pop calls)
+ '("irc.libera.chat" 6697 "tester" "unknown" t
+ nil nil nil nil nil "user" nil))))
+
+ (ert-info ("Full")
+ (erc-tls :server "irc.gnu.org"
+ :port 7000
+ :user "bobo"
+ :nick "bob"
+ :full-name "Bob's Name"
+ :password "bob:changeme"
+ :client-certificate t
+ :id 'GNU.org)
+ (should (equal (pop calls)
+ '("irc.gnu.org" 7000 "bob" "Bob's Name" t
+ "bob:changeme" nil nil nil t "bobo" GNU.org))))
+
+ ;; Values are often nil when called by lisp code, which leads to
+ ;; null params. This is why `erc-open' recomputes almost
+ ;; everything.
+ (ert-info ("Fallback")
+ (let ((erc-nick "bob")
+ (erc-server "irc.gnu.org")
+ (erc-email-userid "bobo")
+ (erc-user-full-name "Bob's Name"))
+ (erc-tls :server nil
+ :port 7000
+ :nick nil
+ :password "bob:changeme"))
+ (should (equal (pop calls)
+ '(nil 7000 nil "Bob's Name" t
+ "bob:changeme" nil nil nil nil "bobo" nil)))))))
+
+(defun erc-tests--make-server-buf (name)
+ (with-current-buffer (get-buffer-create name)
+ (erc-mode)
+ (setq erc-server-process (start-process "sleep" (current-buffer)
+ "sleep" "1")
+ erc-session-server (concat "irc." name ".org")
+ erc-session-port 6667
+ erc-network (intern name))
+ (set-process-query-on-exit-flag erc-server-process nil)
+ (current-buffer)))
+
+(defun erc-tests--make-client-buf (server name)
+ (unless (bufferp server)
+ (setq server (get-buffer server)))
+ (with-current-buffer (get-buffer-create name)
+ (erc-mode)
+ (setq erc--target (erc--target-from-string name))
+ (dolist (v '(erc-server-process
+ erc-session-server
+ erc-session-port
+ erc-network))
+ (set v (buffer-local-value v server)))
+ (current-buffer)))
+
+(ert-deftest erc-handle-irc-url ()
+ (let* (calls
+ rvbuf
+ erc-networks-alist
+ erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook
+ (erc-url-connect-function
+ (lambda (&rest r)
+ (push r calls)
+ (if (functionp rvbuf) (funcall rvbuf) rvbuf))))
+
+ (cl-letf (((symbol-function 'erc-cmd-JOIN)
+ (lambda (&rest r) (push r calls))))
+
+ (with-current-buffer (erc-tests--make-server-buf "foonet")
+ (setq rvbuf (current-buffer)))
+ (erc-tests--make-server-buf "barnet")
+ (erc-tests--make-server-buf "baznet")
+
+ (ert-info ("Unknown network")
+ (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil "irc")
+ (should (equal '("#chan" nil) (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Unknown network, no port")
+ (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil "irc")
+ (should (equal '("#chan" nil) (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Known network, no port")
+ (setq erc-networks-alist '((foonet "irc.foonet.org")))
+ (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil "irc")
+ (should (equal '("#chan" nil) (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Known network, different port")
+ (erc-handle-irc-url "irc.foonet.org" 6697 "#chan" nil nil "irc")
+ (should (equal '("#chan" nil) (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Known network, existing chan with key")
+ (erc-tests--make-client-buf "foonet" "#chan")
+ (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil "irc")
+ (should (equal '("#chan" "sec") (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Unknown network, connect, no chan")
+ (erc-handle-irc-url "irc.gnu.org" nil nil nil nil "irc")
+ (should (equal '("irc" :server "irc.gnu.org") (pop calls)))
+ (should-not calls))
+
+ (ert-info ("Unknown network, connect, chan")
+ (with-current-buffer "foonet"
+ (should-not (local-variable-p 'erc-after-connect)))
+ (setq rvbuf (lambda () (erc-tests--make-server-buf "gnu")))
+ (erc-handle-irc-url "irc.gnu.org" nil "#spam" nil nil "irc")
+ (should (equal '("irc" :server "irc.gnu.org") (pop calls)))
+ (should-not calls)
+ (with-current-buffer "gnu"
+ (should (local-variable-p 'erc-after-connect))
+ (funcall (car erc-after-connect))
+ (should (equal '("#spam" nil) (pop calls)))
+ (should-not (local-variable-p 'erc-after-connect)))
+ (should-not calls))))
+
+ (when noninteractive
+ (kill-buffer "foonet")
+ (kill-buffer "barnet")
+ (kill-buffer "baznet")
+ (kill-buffer "#chan")))
+
;;; erc-tests.el ends here
diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el
b/test/lisp/erc/resources/erc-d/erc-d-tests.el
index a4befd96b5..8dd5cef7aa 100644
--- a/test/lisp/erc/resources/erc-d/erc-d-tests.el
+++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el
@@ -562,6 +562,7 @@ DUMB-SERVER-VAR are bound accordingly in BODY."
;;
(erc-server-flood-penalty 0.05)
erc-autojoin-channels-alist
+ erc-after-connect
erc-server-auto-reconnect)
(should-not erc-d--slow-mo)
(with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting"))
diff --git a/test/lisp/erc/resources/erc-scenarios-common.el
b/test/lisp/erc/resources/erc-scenarios-common.el
index bc2cb68cd8..ef65125241 100644
--- a/test/lisp/erc/resources/erc-scenarios-common.el
+++ b/test/lisp/erc/resources/erc-scenarios-common.el
@@ -73,7 +73,7 @@
(require 'erc-d-t)
(require 'erc-d)))
-(require 'erc-backend)
+(require 'erc)
(eval-when-compile (require 'erc-join)
(require 'erc-services))
@@ -125,6 +125,7 @@
(erc-auth-source-parameters-join-function nil)
(erc-autojoin-channels-alist nil)
(erc-server-auto-reconnect nil)
+ (erc-after-connect nil)
(erc-d-linger-secs 10)
,@bindings)))
diff --git a/test/lisp/erc/resources/join/legacy/foonet.eld
b/test/lisp/erc/resources/join/legacy/foonet.eld
index 344ba7c1da..4025094a59 100644
--- a/test/lisp/erc/resources/join/legacy/foonet.eld
+++ b/test/lisp/erc/resources/join/legacy/foonet.eld
@@ -1,5 +1,5 @@
;; -*- mode: lisp-data; -*-
-((pass 1 "PASS :changeme"))
+((pass 10 "PASS :changeme"))
((nick 1 "NICK tester"))
((user 1 "USER user 0 * :tester")
(0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester")
diff --git a/test/lisp/eshell/em-tramp-tests.el
b/test/lisp/eshell/em-tramp-tests.el
index 8969c1e229..6cc35ecdb1 100644
--- a/test/lisp/eshell/em-tramp-tests.el
+++ b/test/lisp/eshell/em-tramp-tests.el
@@ -85,4 +85,79 @@
`(,(format "/sudo:USER@%s:%s" tramp-default-host
default-directory)
("echo" ("-u" "hi")))))))
+(ert-deftest em-tramp-test/sudo-shell ()
+ "Test Eshell `sudo' command with -s/--shell option."
+ (dolist (args '(("--shell")
+ ("-s")))
+ (should (equal
+ (catch 'eshell-replace-command (apply #'eshell/sudo args))
+ `(eshell-trap-errors
+ (eshell-named-command
+ "cd"
+ (list ,(format "/sudo:root@%s:%s"
+ tramp-default-host default-directory))))))))
+
+(ert-deftest em-tramp-test/sudo-user-shell ()
+ "Test Eshell `sudo' command with -s and -u options."
+ (should (equal
+ (catch 'eshell-replace-command (eshell/sudo "-u" "USER" "-s"))
+ `(eshell-trap-errors
+ (eshell-named-command
+ "cd"
+ (list ,(format "/sudo:USER@%s:%s"
+ tramp-default-host default-directory)))))))
+
+(ert-deftest em-tramp-test/doas-basic ()
+ "Test Eshell `doas' command with default user."
+ (cl-letf (((symbol-function 'eshell-named-command)
+ #'mock-eshell-named-command))
+ (should (equal
+ (catch 'eshell-external (eshell/doas "echo" "hi"))
+ `(,(format "/doas:root@%s:%s"
+ tramp-default-host default-directory)
+ ("echo" ("hi")))))
+ (should (equal
+ (catch 'eshell-external (eshell/doas "echo" "-u" "hi"))
+ `(,(format "/doas:root@%s:%s"
+ tramp-default-host default-directory)
+ ("echo" ("-u" "hi")))))))
+
+(ert-deftest em-tramp-test/doas-user ()
+ "Test Eshell `doas' command with specified user."
+ (cl-letf (((symbol-function 'eshell-named-command)
+ #'mock-eshell-named-command))
+ (should (equal
+ (catch 'eshell-external (eshell/doas "-u" "USER" "echo" "hi"))
+ `(,(format "/doas:USER@%s:%s"
+ tramp-default-host default-directory)
+ ("echo" ("hi")))))
+ (should (equal
+ (catch 'eshell-external
+ (eshell/doas "-u" "USER" "echo" "-u" "hi"))
+ `(,(format "/doas:USER@%s:%s"
+ tramp-default-host default-directory)
+ ("echo" ("-u" "hi")))))))
+
+(ert-deftest em-tramp-test/doas-shell ()
+ "Test Eshell `doas' command with -s/--shell option."
+ (dolist (args '(("--shell")
+ ("-s")))
+ (should (equal
+ (catch 'eshell-replace-command (apply #'eshell/doas args))
+ `(eshell-trap-errors
+ (eshell-named-command
+ "cd"
+ (list ,(format "/doas:root@%s:%s"
+ tramp-default-host default-directory))))))))
+
+(ert-deftest em-tramp-test/doas-user-shell ()
+ "Test Eshell `doas' command with -s and -u options."
+ (should (equal
+ (catch 'eshell-replace-command (eshell/doas "-u" "USER" "-s"))
+ `(eshell-trap-errors
+ (eshell-named-command
+ "cd"
+ (list ,(format "/doas:USER@%s:%s"
+ tramp-default-host default-directory)))))))
+
;;; em-tramp-tests.el ends here
diff --git a/test/lisp/eshell/esh-ext-tests.el
b/test/lisp/eshell/esh-ext-tests.el
new file mode 100644
index 0000000000..54191e9409
--- /dev/null
+++ b/test/lisp/eshell/esh-ext-tests.el
@@ -0,0 +1,76 @@
+;;; esh-ext-tests.el --- esh-ext test suite -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 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:
+
+;; Tests for Eshell's external command handling.
+
+;;; Code:
+
+(require 'ert)
+(require 'esh-mode)
+(require 'esh-ext)
+(require 'eshell)
+
+(require 'eshell-tests-helpers
+ (expand-file-name "eshell-tests-helpers"
+ (file-name-directory (or load-file-name
+ default-directory))))
+
+;;; Tests:
+
+(ert-deftest esh-ext-test/addpath/end ()
+ "Test that \"addpath\" adds paths to the end of $PATH."
+ (with-temp-eshell
+ (let ((eshell-path-env-list '("/some/path" "/other/path"))
+ (expected-path (string-join '("/some/path" "/other/path" "/new/path"
+ "/new/path2")
+ (path-separator))))
+ (eshell-match-command-output "addpath /new/path /new/path2"
+ (concat expected-path "\n"))
+ (eshell-match-command-output "echo $PATH"
+ (concat expected-path "\n")))))
+
+(ert-deftest esh-ext-test/addpath/begin ()
+ "Test that \"addpath -b\" adds paths to the beginning of $PATH."
+ (with-temp-eshell
+ (let ((eshell-path-env-list '("/some/path" "/other/path"))
+ (expected-path (string-join '("/new/path" "/new/path2" "/some/path"
+ "/other/path")
+ (path-separator))))
+ (eshell-match-command-output "addpath -b /new/path /new/path2"
+ (concat expected-path "\n"))
+ (eshell-match-command-output "echo $PATH"
+ (concat expected-path "\n")))))
+
+(ert-deftest esh-ext-test/addpath/set-locally ()
+ "Test adding to the path temporarily in a subcommand."
+ (let* ((eshell-path-env-list '("/some/path" "/other/path"))
+ (original-path (string-join eshell-path-env-list (path-separator)))
+ (local-path (string-join (append eshell-path-env-list '("/new/path"))
+ (path-separator))))
+ (with-temp-eshell
+ (eshell-match-command-output
+ "{ addpath /new/path; env }"
+ (format "PATH=%s\n" (regexp-quote local-path)))
+ ;; After the last command, the previous $PATH value should be restored.
+ (eshell-match-command-output "echo $PATH"
+ (concat original-path "\n")))))
+
+;; esh-ext-tests.el ends here
diff --git a/test/lisp/eshell/esh-util-tests.el
b/test/lisp/eshell/esh-util-tests.el
new file mode 100644
index 0000000000..1cbd015999
--- /dev/null
+++ b/test/lisp/eshell/esh-util-tests.el
@@ -0,0 +1,57 @@
+;;; esh-util-tests.el --- esh-util test suite -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 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 'esh-util)
+
+;;; Tests:
+
+(ert-deftest esh-util-test/eshell-stringify/string ()
+ "Test that `eshell-stringify' preserves the value of strings."
+ (should (equal (eshell-stringify "hello") "hello")))
+
+(ert-deftest esh-util-test/eshell-stringify/number ()
+ "Test that `eshell-stringify' converts numbers to strings."
+ (should (equal (eshell-stringify 42) "42"))
+ (should (equal (eshell-stringify 4.2) "4.2")))
+
+(ert-deftest esh-util-test/eshell-stringify/t ()
+ "Test that `eshell-stringify' treats `t' according to `eshell-stringify-t'."
+ (let ((eshell-stringify-t t))
+ (should (equal (eshell-stringify t) "t")))
+ (let ((eshell-stringify-t nil))
+ (should (equal (eshell-stringify t) nil))))
+
+(ert-deftest esh-util-test/eshell-stringify/nil ()
+ "Test that `eshell-stringify' converts nil to a string."
+ (should (equal (eshell-stringify nil) "nil")))
+
+(ert-deftest esh-util-test/eshell-stringify/list ()
+ "Test that `eshell-stringify' correctly stringifies lists."
+ (should (equal (eshell-stringify '(1 2 3)) "(1 2 3)"))
+ (should (equal (eshell-stringify '((1 2) (3 . 4)))
+ "((1 2)\n (3 . 4))")))
+
+(ert-deftest esh-util-test/eshell-stringify/complex ()
+ "Test that `eshell-stringify' correctly stringifies complex objects."
+ (should (equal (eshell-stringify (list 'quote 'hello)) "'hello")))
+
+;;; esh-util-tests.el ends here
diff --git a/test/lisp/eshell/esh-var-tests.el
b/test/lisp/eshell/esh-var-tests.el
index cb5b1766bb..245a8e6a26 100644
--- a/test/lisp/eshell/esh-var-tests.el
+++ b/test/lisp/eshell/esh-var-tests.el
@@ -23,8 +23,10 @@
;;; Code:
+(require 'tramp)
(require 'ert)
(require 'esh-mode)
+(require 'esh-var)
(require 'eshell)
(require 'eshell-tests-helpers
@@ -440,6 +442,152 @@ inside double-quotes"
"000"))
+;; Variable-related commands
+
+(ert-deftest esh-var-test/set/env-var ()
+ "Test that `set' with a string variable name sets an environment variable."
+ (with-temp-eshell
+ (eshell-match-command-output "set VAR hello" "hello\n")
+ (should (equal (getenv "VAR") "hello")))
+ (should-not (equal (getenv "VAR") "hello")))
+
+(ert-deftest esh-var-test/set/symbol ()
+ "Test that `set' with a symbol variable name sets a Lisp variable."
+ (let (eshell-test-value)
+ (eshell-command-result-equal "set #'eshell-test-value hello"
+ "hello")
+ (should (equal eshell-test-value "hello"))))
+
+(ert-deftest esh-var-test/unset/env-var ()
+ "Test that `unset' with a string variable name unsets an env var."
+ (let ((process-environment (cons "VAR=value" process-environment)))
+ (with-temp-eshell
+ (eshell-match-command-output "unset VAR" "\\`\\'")
+ (should (equal (getenv "VAR") nil)))
+ (should (equal (getenv "VAR") "value"))))
+
+(ert-deftest esh-var-test/unset/symbol ()
+ "Test that `unset' with a symbol variable name unsets a Lisp variable."
+ (let ((eshell-test-value "value"))
+ (eshell-command-result-equal "unset #'eshell-test-value" nil)
+ (should (equal eshell-test-value nil))))
+
+(ert-deftest esh-var-test/setq ()
+ "Test that `setq' sets Lisp variables."
+ (let (eshell-test-value)
+ (eshell-command-result-equal "setq eshell-test-value hello"
+ "hello")
+ (should (equal eshell-test-value "hello"))))
+
+(ert-deftest esh-var-test/export ()
+ "Test that `export' sets environment variables."
+ (with-temp-eshell
+ (eshell-match-command-output "export VAR=hello" "\\`\\'")
+ (should (equal (getenv "VAR") "hello"))))
+
+(ert-deftest esh-var-test/local-variables ()
+ "Test that \"VAR=value command\" temporarily sets variables."
+ (with-temp-eshell
+ (push "VAR=value" process-environment)
+ (eshell-match-command-output "VAR=hello env" "VAR=hello\n")
+ (should (equal (getenv "VAR") "value"))))
+
+
+;; Variable aliases
+
+(ert-deftest esh-var-test/alias/function ()
+ "Test using a variable alias defined as a function."
+ (let ((text-quoting-style 'grave))
+ (with-temp-eshell
+ (push `("ALIAS" ,(lambda () "value") nil t) eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "value\n")
+ (eshell-match-command-output "set ALIAS hello"
+ "Variable `ALIAS' is not settable\n"
+ nil t))))
+
+(ert-deftest esh-var-test/alias/function-pair ()
+ "Test using a variable alias defined as a pair of getter/setter functions."
+ (with-temp-eshell
+ (let ((eshell-test-value "value"))
+ (push `("ALIAS" (,(lambda () eshell-test-value)
+ . (lambda (_ value)
+ (setq eshell-test-value (upcase value))))
+ nil t)
+ eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "value\n")
+ (eshell-match-command-output "set ALIAS hello" "HELLO\n")
+ (should (equal eshell-test-value "HELLO")))))
+
+(ert-deftest esh-var-test/alias/string ()
+ "Test using a variable alias defined as a string.
+This should get/set the aliased environment variable."
+ (with-temp-eshell
+ (let ((eshell-test-value "lisp-value"))
+ (push "eshell-test-value=env-value" process-environment)
+ (push `("ALIAS" "eshell-test-value") eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "env-value\n")
+ (eshell-match-command-output "set ALIAS hello" "hello\n")
+ (should (equal (getenv "eshell-test-value") "hello"))
+ (should (equal eshell-test-value "lisp-value")))))
+
+(ert-deftest esh-var-test/alias/string/prefer-lisp ()
+ "Test using a variable alias defined as a string.
+This sets `eshell-prefer-lisp-variables' to t and should get/set
+the aliased Lisp variable."
+ (with-temp-eshell
+ (let ((eshell-test-value "lisp-value")
+ (eshell-prefer-lisp-variables t))
+ (push "eshell-test-value=env-value" process-environment)
+ (push `("ALIAS" "eshell-test-value") eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "lisp-value\n")
+ (eshell-match-command-output "set ALIAS hello" "hello\n")
+ (should (equal (car process-environment) "eshell-test-value=env-value"))
+ (should (equal eshell-test-value "hello")))))
+
+(ert-deftest esh-var-test/alias/symbol ()
+ "Test using a variable alias defined as a symbol.
+This should get/set the value bound to the symbol."
+ (with-temp-eshell
+ (let ((eshell-test-value "value"))
+ (push '("ALIAS" eshell-test-value) eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "value\n")
+ (eshell-match-command-output "set ALIAS hello" "hello\n")
+ (should (equal eshell-test-value "hello")))))
+
+(ert-deftest esh-var-test/alias/symbol-pair ()
+ "Test using a variable alias defined as a pair of symbols.
+This should get the value bound to the symbol, but fail to set
+it, since the setter is nil."
+ (with-temp-eshell
+ (let ((eshell-test-value "value")
+ (text-quoting-style 'grave))
+ (push '("ALIAS" (eshell-test-value . nil)) eshell-variable-aliases-list)
+ (eshell-match-command-output "echo $ALIAS" "value\n")
+ (eshell-match-command-output "set ALIAS hello"
+ "Variable `ALIAS' is not settable\n"
+ nil t))))
+
+(ert-deftest esh-var-test/alias/export ()
+ "Test that `export' properly sets variable aliases."
+ (with-temp-eshell
+ (let ((eshell-test-value "value"))
+ (push `("ALIAS" (,(lambda () eshell-test-value)
+ . (lambda (_ value) (setq eshell-test-value value)))
+ nil t)
+ eshell-variable-aliases-list)
+ (eshell-match-command-output "export ALIAS=hello" "\\`\\'")
+ (should (equal eshell-test-value "hello")))))
+
+(ert-deftest esh-var-test/alias/local-variables ()
+ "Test that \"VAR=value cmd\" temporarily sets read-only variable aliases."
+ (with-temp-eshell
+ (let ((eshell-test-value "value"))
+ (push `("ALIAS" ,(lambda () eshell-test-value) t t)
+ eshell-variable-aliases-list)
+ (eshell-match-command-output "ALIAS=hello env" "ALIAS=hello\n")
+ (should (equal eshell-test-value "value")))))
+
+
;; Built-in variables
(ert-deftest esh-var-test/lines-var ()
@@ -465,6 +613,65 @@ inside double-quotes"
(eshell-match-command-output "echo $INSIDE_EMACS[, 1]"
"eshell")))
+(ert-deftest esh-var-test/path-var/local-directory ()
+ "Test using $PATH in a local directory."
+ (let ((expected-path (string-join (eshell-get-path t) (path-separator))))
+ (with-temp-eshell
+ (eshell-match-command-output "echo $PATH" (regexp-quote expected-path)))))
+
+(ert-deftest esh-var-test/path-var/remote-directory ()
+ "Test using $PATH in a remote directory."
+ (skip-unless (eshell-tests-remote-accessible-p))
+ (let* ((default-directory ert-remote-temporary-file-directory)
+ (expected-path (string-join (eshell-get-path t) (path-separator))))
+ (with-temp-eshell
+ (eshell-match-command-output "echo $PATH" (regexp-quote expected-path)))))
+
+(ert-deftest esh-var-test/path-var/set ()
+ "Test setting $PATH."
+ (let* ((path-to-set-list '("/some/path" "/other/path"))
+ (path-to-set (string-join path-to-set-list (path-separator))))
+ (with-temp-eshell
+ (eshell-match-command-output (concat "set PATH " path-to-set)
+ (concat path-to-set "\n"))
+ (eshell-match-command-output "echo $PATH" (concat path-to-set "\n"))
+ (should (equal (eshell-get-path t) path-to-set-list)))))
+
+(ert-deftest esh-var-test/path-var/set-locally ()
+ "Test setting $PATH temporarily for a single command."
+ (let* ((path-to-set-list '("/some/path" "/other/path"))
+ (path-to-set (string-join path-to-set-list (path-separator))))
+ (with-temp-eshell
+ (eshell-match-command-output (concat "set PATH " path-to-set)
+ (concat path-to-set "\n"))
+ (eshell-match-command-output "PATH=/local/path env"
+ "PATH=/local/path\n")
+ ;; After the last command, the previous $PATH value should be restored.
+ (eshell-match-command-output "echo $PATH" (concat path-to-set "\n"))
+ (should (equal (eshell-get-path t) path-to-set-list)))))
+
+(ert-deftest esh-var-test/path-var/preserve-across-hosts ()
+ "Test that $PATH can be set independently on multiple hosts."
+ (let ((local-directory default-directory)
+ local-path remote-path)
+ (with-temp-eshell
+ ;; Set the $PATH on localhost.
+ (eshell-insert-command "set PATH /local/path")
+ (setq local-path (eshell-last-output))
+ ;; `cd' to a remote host and set the $PATH there too.
+ (eshell-insert-command
+ (format "cd %s" ert-remote-temporary-file-directory))
+ (eshell-insert-command "set PATH /remote/path")
+ (setq remote-path (eshell-last-output))
+ ;; Return to localhost and check that $PATH is the value we set
+ ;; originally.
+ (eshell-insert-command (format "cd %s" local-directory))
+ (eshell-match-command-output "echo $PATH" (regexp-quote local-path))
+ ;; ... and do the same for the remote host.
+ (eshell-insert-command
+ (format "cd %s" ert-remote-temporary-file-directory))
+ (eshell-match-command-output "echo $PATH" (regexp-quote remote-path)))))
+
(ert-deftest esh-var-test/last-status-var-lisp-command ()
"Test using the \"last exit status\" ($?) variable with a Lisp command"
(with-temp-eshell
@@ -472,9 +679,8 @@ inside double-quotes"
"t\n0\n")
(eshell-match-command-output "zerop 1; echo $?"
"0\n")
- (let ((debug-on-error nil))
- (eshell-match-command-output "zerop foo; echo $?"
- "1\n"))))
+ (eshell-match-command-output "zerop foo; echo $?"
+ "1\n" nil t)))
(ert-deftest esh-var-test/last-status-var-lisp-form ()
"Test using the \"last exit status\" ($?) variable with a Lisp form"
@@ -484,9 +690,8 @@ inside double-quotes"
"t\n0\n")
(eshell-match-command-output "(zerop 1); echo $?"
"2\n")
- (let ((debug-on-error nil))
- (eshell-match-command-output "(zerop \"foo\"); echo $?"
- "1\n")))))
+ (eshell-match-command-output "(zerop \"foo\"); echo $?"
+ "1\n" nil t))))
(ert-deftest esh-var-test/last-status-var-lisp-form-2 ()
"Test using the \"last exit status\" ($?) variable with a Lisp form.
@@ -497,9 +702,8 @@ This tests when `eshell-lisp-form-nil-is-failure' is nil."
"0\n")
(eshell-match-command-output "(zerop 0); echo $?"
"0\n")
- (let ((debug-on-error nil))
- (eshell-match-command-output "(zerop \"foo\"); echo $?"
- "1\n")))))
+ (eshell-match-command-output "(zerop \"foo\"); echo $?"
+ "1\n" nil t))))
(ert-deftest esh-var-test/last-status-var-ext-cmd ()
"Test using the \"last exit status\" ($?) variable with an external command"
diff --git a/test/lisp/eshell/eshell-tests-helpers.el
b/test/lisp/eshell/eshell-tests-helpers.el
index 73abfcbb55..1d9674070c 100644
--- a/test/lisp/eshell/eshell-tests-helpers.el
+++ b/test/lisp/eshell/eshell-tests-helpers.el
@@ -31,11 +31,22 @@
(require 'eshell)
(defvar eshell-history-file-name nil)
+(defvar eshell-last-dir-ring-file-name nil)
(defvar eshell-test--max-subprocess-time 5
"The maximum amount of time to wait for a subprocess to finish, in seconds.
See `eshell-wait-for-subprocess'.")
+(defun eshell-tests-remote-accessible-p ()
+ "Return if a test involving remote files can proceed.
+If using this function, be sure to load `tramp' near the
+beginning of the test file."
+ (ignore-errors
+ (and
+ (file-remote-p ert-remote-temporary-file-directory)
+ (file-directory-p ert-remote-temporary-file-directory)
+ (file-writable-p ert-remote-temporary-file-directory))))
+
(defmacro with-temp-eshell (&rest body)
"Evaluate BODY in a temporary Eshell buffer."
`(save-current-buffer
@@ -44,6 +55,7 @@ See `eshell-wait-for-subprocess'.")
;; back on $HISTFILE.
(process-environment (cons "HISTFILE" process-environment))
(eshell-history-file-name nil)
+ (eshell-last-dir-ring-file-name nil)
(eshell-buffer (eshell t)))
(unwind-protect
(with-current-buffer eshell-buffer
@@ -83,26 +95,39 @@ After inserting, call FUNC. If FUNC is nil, instead call
(insert-and-inherit command)
(funcall (or func 'eshell-send-input)))
+(defun eshell-last-input ()
+ "Return the input of the last Eshell command."
+ (buffer-substring-no-properties
+ eshell-last-input-start eshell-last-input-end))
+
+(defun eshell-last-output ()
+ "Return the output of the last Eshell command."
+ (buffer-substring-no-properties
+ (eshell-beginning-of-output) (eshell-end-of-output)))
+
(defun eshell-match-output (regexp)
"Test whether the output of the last command matches REGEXP."
- (string-match-p
- regexp (buffer-substring-no-properties
- (eshell-beginning-of-output) (eshell-end-of-output))))
+ (string-match-p regexp (eshell-last-output)))
(defun eshell-match-output--explainer (regexp)
"Explain the result of `eshell-match-output'."
`(mismatched-output
- (command ,(buffer-substring-no-properties
- eshell-last-input-start eshell-last-input-end))
- (output ,(buffer-substring-no-properties
- (eshell-beginning-of-output) (eshell-end-of-output)))
+ (command ,(eshell-last-input))
+ (output ,(eshell-last-output))
(regexp ,regexp)))
(put 'eshell-match-output 'ert-explainer #'eshell-match-output--explainer)
-(defun eshell-match-command-output (command regexp &optional func)
- "Insert a COMMAND at the end of the buffer and match the output with REGEXP."
- (eshell-insert-command command func)
+(defun eshell-match-command-output (command regexp &optional func
+ ignore-errors)
+ "Insert a COMMAND at the end of the buffer and match the output with REGEXP.
+FUNC is the function to call after inserting the text (see
+`eshell-insert-command').
+
+If IGNORE-ERRORS is non-nil, ignore any errors signaled when
+inserting the command."
+ (let ((debug-on-error (and (not ignore-errors) debug-on-error)))
+ (eshell-insert-command command func))
(eshell-wait-for-subprocess)
(should (eshell-match-output regexp)))
diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el
index 7ee2f0c1a6..b1555a0266 100644
--- a/test/lisp/files-x-tests.el
+++ b/test/lisp/files-x-tests.el
@@ -23,6 +23,7 @@
(require 'ert)
(require 'files-x)
+(require 'tramp-integration)
(defconst files-x-test--variables1
'((remote-shell-file-name . "/bin/bash")
@@ -35,16 +36,20 @@
'((remote-null-device . "/dev/null")))
(defconst files-x-test--variables4
'((remote-null-device . "null")))
+(defconst files-x-test--variables5
+ '((remote-lazy-var . nil)
+ (remote-null-device . "/dev/null")))
(defvar remote-null-device)
+(defvar remote-lazy-var nil)
(put 'remote-shell-file-name 'safe-local-variable #'identity)
(put 'remote-shell-command-switch 'safe-local-variable #'identity)
(put 'remote-shell-interactive-switch 'safe-local-variable #'identity)
(put 'remote-shell-login-switch 'safe-local-variable #'identity)
(put 'remote-null-device 'safe-local-variable #'identity)
-(defconst files-x-test--application '(:application 'my-application))
+(defconst files-x-test--application '(:application my-application))
(defconst files-x-test--another-application
- '(:application 'another-application))
+ '(:application another-application))
(defconst files-x-test--protocol '(:protocol "my-protocol"))
(defconst files-x-test--user '(:user "my-user"))
(defconst files-x-test--machine '(:machine "my-machine"))
@@ -91,6 +96,28 @@
(connection-local-get-profile-variables 'remote-nullfile)
files-x-test--variables4))))
+(ert-deftest files-x-test-connection-local-update-profile-variables ()
+ "Test updating connection-local profile variables."
+
+ ;; Declare (PROFILE VARIABLES) objects.
+ (let (connection-local-profile-alist connection-local-criteria-alist)
+ (connection-local-set-profile-variables
+ 'remote-bash (copy-alist files-x-test--variables1))
+ (should
+ (equal
+ (connection-local-get-profile-variables 'remote-bash)
+ files-x-test--variables1))
+
+ ;; Updating overwrites only the values specified in this call, but
+ ;; retains all the other values from previous calls.
+ (connection-local-update-profile-variables
+ 'remote-bash files-x-test--variables2)
+ (should
+ (equal
+ (connection-local-get-profile-variables 'remote-bash)
+ (cons (car files-x-test--variables2)
+ (cdr files-x-test--variables1))))))
+
(ert-deftest files-x-test-connection-local-set-profiles ()
"Test setting connection-local profiles."
@@ -233,9 +260,12 @@
(nreverse (copy-tree files-x-test--variables2)))))
;; The variables exist also as local variables.
(should (local-variable-p 'remote-shell-file-name))
+ (should (local-variable-p 'remote-null-device))
;; The proper variable value is set.
(should
- (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh"))))
+ (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh"))
+ (should
+ (string-equal (symbol-value 'remote-null-device) "/dev/null"))))
;; The third test case. Both criteria `files-x-test--criteria1'
;; and `files-x-test--criteria2' apply, but there are no double
@@ -274,13 +304,11 @@
(should-not (local-variable-p 'remote-shell-file-name))
(should-not (boundp 'remote-shell-file-name))))))
-(defvar tramp-connection-local-default-shell-variables)
-(defvar tramp-connection-local-default-system-variables)
-
(ert-deftest files-x-test-with-connection-local-variables ()
"Test setting connection-local variables."
- (let (connection-local-profile-alist connection-local-criteria-alist)
+ (let ((connection-local-profile-alist connection-local-profile-alist)
+ (connection-local-criteria-alist connection-local-criteria-alist))
(connection-local-set-profile-variables
'remote-bash files-x-test--variables1)
(connection-local-set-profile-variables
@@ -291,29 +319,6 @@
(connection-local-set-profiles
nil 'remote-ksh 'remote-nullfile)
- (with-temp-buffer
- (let ((enable-connection-local-variables t))
- (hack-connection-local-variables-apply nil)
-
- ;; All connection-local variables are set. They apply in
- ;; reverse order in `connection-local-variables-alist'.
- (should
- (equal connection-local-variables-alist
- (append
- (nreverse (copy-tree files-x-test--variables3))
- (nreverse (copy-tree files-x-test--variables2)))))
- ;; The variables exist also as local variables.
- (should (local-variable-p 'remote-shell-file-name))
- (should (local-variable-p 'remote-null-device))
- ;; The proper variable values are set.
- (should
- (string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh"))
- (should
- (string-equal (symbol-value 'remote-null-device) "/dev/null"))
-
- ;; A candidate connection-local variable is not bound yet.
- (should-not (local-variable-p 'remote-shell-command-switch))))
-
(with-temp-buffer
;; Use the macro. We need a remote `default-directory'.
(let ((enable-connection-local-variables t)
@@ -331,18 +336,18 @@
(with-connection-local-variables
;; All connection-local variables are set. They apply in
;; reverse order in `connection-local-variables-alist'.
- ;; Since we ha a remote default directory, Tramp's settings
+ ;; Since we have a remote default directory, Tramp's settings
;; are appended as well.
(should
(equal
connection-local-variables-alist
(append
- (nreverse (copy-tree files-x-test--variables3))
- (nreverse (copy-tree files-x-test--variables2))
(nreverse
(copy-tree tramp-connection-local-default-shell-variables))
(nreverse
- (copy-tree tramp-connection-local-default-system-variables)))))
+ (copy-tree tramp-connection-local-default-system-variables))
+ (nreverse (copy-tree files-x-test--variables3))
+ (nreverse (copy-tree files-x-test--variables2)))))
;; The variables exist also as local variables.
(should (local-variable-p 'remote-shell-file-name))
(should (local-variable-p 'remote-null-device))
@@ -352,15 +357,21 @@
(should
(string-equal (symbol-value 'remote-null-device) "/dev/null"))
- ;; Run another instance of `with-connection-local-variables'
- ;; with a different application.
- (let ((connection-local-default-application (cadr
files-x-test--application)))
- (with-connection-local-variables
- ;; The proper variable values are set.
- (should
- (string-equal (symbol-value 'remote-shell-file-name) "/bin/bash"))
- (should
- (string-equal (symbol-value 'remote-null-device) "/dev/null"))))
+ ;; Run `with-connection-local-application-variables' to use a
+ ;; different application.
+ (with-connection-local-application-variables
+ (cadr files-x-test--application)
+ (should
+ (equal
+ connection-local-variables-alist
+ (append
+ (nreverse (copy-tree files-x-test--variables3))
+ (nreverse (copy-tree files-x-test--variables1)))))
+ ;; The proper variable values are set.
+ (should
+ (string-equal (symbol-value 'remote-shell-file-name) "/bin/bash"))
+ (should
+ (string-equal (symbol-value 'remote-null-device) "/dev/null")))
;; The variable values are reset.
(should
(string-equal (symbol-value 'remote-shell-file-name) "/bin/ksh"))
@@ -376,5 +387,60 @@
(should-not (boundp 'remote-shell-file-name))
(should (string-equal (symbol-value 'remote-null-device) "null"))))))
+(defun files-x-test--get-lazy-var ()
+ "Get the connection-local value of `remote-lazy-var'.
+If it's not initialized yet, initialize it."
+ (with-connection-local-application-variables
+ (cadr files-x-test--application)
+ (or remote-lazy-var
+ (setq-connection-local remote-lazy-var
+ (or (file-remote-p default-directory 'host)
+ "local")))))
+
+(defun files-x-test--set-lazy-var (value)
+ "Set the connection-local value of `remote-lazy-var'"
+ (with-connection-local-application-variables
+ (cadr files-x-test--application)
+ (setq-connection-local remote-lazy-var value)))
+
+(ert-deftest files-x-test-setq-connection-local ()
+ "Test dynamically setting connection local variables."
+ (let (connection-local-profile-alist connection-local-criteria-alist)
+ (connection-local-set-profile-variables
+ 'remote-lazy files-x-test--variables5)
+ (connection-local-set-profiles
+ files-x-test--application
+ 'remote-lazy)
+
+ ;; Test the initial local value.
+ (should (equal (files-x-test--get-lazy-var) "local"))
+
+ ;; Set the local value and make sure it retains the value we set.
+ (should (equal (files-x-test--set-lazy-var "here") "here"))
+ (should (equal (files-x-test--get-lazy-var) "here"))
+
+ (let ((default-directory "/method:host:"))
+ ;; Test the initial remote value.
+ (should (equal (files-x-test--get-lazy-var) "host"))
+
+ ;; Set the remote value and make sure it retains the value we set.
+ (should (equal (files-x-test--set-lazy-var "there") "there"))
+ (should (equal (files-x-test--get-lazy-var) "there"))
+ ;; Set another connection-local variable.
+ (with-connection-local-application-variables
+ (cadr files-x-test--application)
+ (setq-connection-local remote-null-device "null")))
+
+ ;; Make sure we get the local value we set above.
+ (should (equal (files-x-test--get-lazy-var) "here"))
+ (should-not (boundp 'remote-null-device))
+
+ ;; Make sure we get the remote values we set above.
+ (let ((default-directory "/method:host:"))
+ (should (equal (files-x-test--get-lazy-var) "there"))
+ (with-connection-local-application-variables
+ (cadr files-x-test--application)
+ (should (equal remote-null-device "null"))))))
+
(provide 'files-x-tests)
;;; files-x-tests.el ends here
diff --git a/test/lisp/image/wallpaper-tests.el
b/test/lisp/image/wallpaper-tests.el
index 52011fe797..a5d3343bd4 100644
--- a/test/lisp/image/wallpaper-tests.el
+++ b/test/lisp/image/wallpaper-tests.el
@@ -23,6 +23,104 @@
(require 'ert-x)
(require 'wallpaper)
+(ert-deftest wallpaper--find-setter ()
+ (skip-unless (executable-find "touch"))
+ (let (wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "/tmp/touched"))))
+ (should (wallpaper--find-setter))))
+
+(ert-deftest wallpaper--find-setter/call-predicate ()
+ (skip-unless (executable-find "touch"))
+ (let* ( wallpaper--current-setter called
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "/tmp/touched"
+ :predicate (lambda () (setq called t))))))
+ (should-not called)
+ (wallpaper--find-setter)
+ (should called)))
+
+(ert-deftest wallpaper--find-setter/set-current-setter ()
+ (skip-unless (executable-find "touch"))
+ (let (wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "/tmp/touched"))))
+ (wallpaper--find-setter)
+ (should wallpaper--current-setter)))
+
+(ert-deftest wallpaper-set/runs-command ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (ert-with-temp-file fil
+ (let* ( wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" fil)))
+ (wallpaper-command (wallpaper--find-command))
+ (wallpaper-command-args (wallpaper--find-command-args)))
+ (delete-file fil)
+ (let ((process (wallpaper-set fil-jpg)))
+ (while (process-live-p process)
+ (sit-for 0.001))
+ ;; Touch has recreated the file:
+ (should (file-exists-p fil)))))))
+
+(ert-deftest wallpaper-set/runs-command/detach ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (ert-with-temp-file fil
+ (let* ( wallpaper--current-setter
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" fil
+ :detach t)))
+ (wallpaper-command (wallpaper--find-command))
+ (wallpaper-command-args (wallpaper--find-command-args)))
+ (delete-file fil)
+ (wallpaper-set fil-jpg)
+ (while (not (file-exists-p fil))
+ (sit-for 0.001))
+ ;; Touch has recreated the file:
+ (should (file-exists-p fil))))))
+
+(ert-deftest wallpaper-set/calls-init-action ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (ert-with-temp-file fil
+ (let* ( wallpaper--current-setter called
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" fil
+ :init-action (lambda () (setq called t)))))
+ (wallpaper-command (wallpaper--find-command))
+ (wallpaper-command-args (wallpaper--find-command-args))
+ process)
+ (should (functionp (wallpaper-setter-init-action
wallpaper--current-setter)))
+ (setq process (wallpaper-set fil-jpg))
+ ;; Wait for "touch" process to exit so temp file is removed.
+ (accept-process-output process 3)
+ (should called)))))
+
+(ert-deftest wallpaper-set/calls-wallpaper-set-function ()
+ (skip-unless (executable-find "touch"))
+ (ert-with-temp-file fil-jpg
+ :suffix ".jpg"
+ (let* ( wallpaper--current-setter called
+ (wallpaper--default-setters
+ (wallpaper--default-methods-create
+ ("touch" "touch" "foo")))
+ (wallpaper-set-function
+ (lambda (file) (setq called file))))
+ (wallpaper--find-setter)
+ (wallpaper-set fil-jpg)
+ (should (equal called fil-jpg)))))
+
(ert-deftest wallpaper--find-command/return-string ()
(should (or (not (wallpaper--find-command))
(stringp (wallpaper--find-command)))))
diff --git a/test/lisp/international/textsec-tests.el
b/test/lisp/international/textsec-tests.el
index 6b0773dc40..1f7fb97a6b 100644
--- a/test/lisp/international/textsec-tests.el
+++ b/test/lisp/international/textsec-tests.el
@@ -77,7 +77,7 @@
(should (eq (textsec-restriction-level "切foo")
'highly-restrictive))
(should (eq (textsec-restriction-level "հfoo")
- 'moderately-retrictive))
+ 'moderately-restrictive))
(should (eq (textsec-restriction-level "Сirсlе")
'unrestricted)))
diff --git a/test/lisp/net/browse-url-tests.el
b/test/lisp/net/browse-url-tests.el
index 1c993958b8..dc81976821 100644
--- a/test/lisp/net/browse-url-tests.el
+++ b/test/lisp/net/browse-url-tests.el
@@ -56,6 +56,15 @@
'browse-url--man))
(should-not (browse-url-select-handler "man:ls" 'external)))
+(ert-deftest browse-url-tests-select-handler-irc ()
+ (should (eq (browse-url-select-handler "irc://localhost" 'internal)
+ 'browse-url--irc))
+ (should-not (browse-url-select-handler "irc://localhost" 'external))
+ (should (eq (browse-url-select-handler "irc6://localhost")
+ 'browse-url--irc))
+ (should (eq (browse-url-select-handler "ircs://tester@irc.gnu.org/#chan")
+ 'browse-url--irc)))
+
(ert-deftest browse-url-tests-select-handler-file ()
(should (eq (browse-url-select-handler "file://foo.txt")
'browse-url-emacs))
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index 7631842918..c808e6350e 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -407,7 +407,7 @@
:session dbus--test-service
'(:array (:dict-entry :string "string" :boolean t :boolean t)))
:type 'wrong-type-argument)
- ;; The first element ist not of a basic type.
+ ;; The first element is not of a basic type.
(should-error
(dbus-check-arguments
:session dbus--test-service
@@ -1093,7 +1093,7 @@ is in progress."
(dbus-unregister-service :session dbus--test-service)))
(ert-deftest dbus-test06-register-property-emits-signal ()
- "Check property registration for an own service, including signalling."
+ "Check property registration for an own service, including signaling."
(skip-unless dbus--test-enabled-session-bus)
(dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
@@ -1136,7 +1136,7 @@ is in progress."
dbus--test-interface property)
"foo"))
- ;; Set property. The new value shall be signalled.
+ ;; Set property. The new value shall be signaled.
(setq dbus--test-signal-received nil)
(should
(equal
diff --git a/test/lisp/net/eudc-resources/bbdb
b/test/lisp/net/eudc-resources/bbdb
new file mode 100644
index 0000000000..b730bb51cc
--- /dev/null
+++ b/test/lisp/net/eudc-resources/bbdb
@@ -0,0 +1,3 @@
+;; -*- mode: Emacs-Lisp; coding: utf-8; -*-
+;;; file-format: 9
+["Emacs" "ERT3" nil nil nil nil nil ("emacs-ert-test-3@bbdb.gnu.org") ((notes
. " ")) "c8bd3a63-3a83-48a7-a95b-be118a923e00" "2022-11-19 16:36:04 +0000"
"2022-11-19 16:36:04 +0000" nil]
diff --git a/test/lisp/net/eudc-resources/dc=gnu,dc=org.ldif
b/test/lisp/net/eudc-resources/dc=gnu,dc=org.ldif
new file mode 100644
index 0000000000..9db4be2028
--- /dev/null
+++ b/test/lisp/net/eudc-resources/dc=gnu,dc=org.ldif
@@ -0,0 +1,15 @@
+# AUTO-GENERATED FILE - DO NOT EDIT!! Use ldapmodify.
+# CRC32 12f0e8c3
+dn: dc=gnu
+objectClass: dcObject
+objectClass: organization
+dc: gnu
+o: The ldap.gnu.org organization
+description: An organization for the following person
+structuralObjectClass: organization
+entryUUID: 43dd74ec-fc0d-103c-8d5c-7dbac5615d14
+creatorsName:
+createTimestamp: 20221119042038Z
+entryCSN: 20221119042038.100000Z#000000#000#000000
+modifiersName:
+modifyTimestamp: 20221119042038Z
diff --git
a/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-1.ldif
b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-1.ldif
new file mode 100644
index 0000000000..7828f179df
--- /dev/null
+++ b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-1.ldif
@@ -0,0 +1,17 @@
+# AUTO-GENERATED FILE - DO NOT EDIT!! Use ldapmodify.
+# CRC32 a33c0168
+dn: cn=emacs-ert-test-1
+objectClass: OpenLDAPperson
+cn: emacs-ert-test-1
+description:: RW1hY3Mg
+uid: 1
+sn: ERT1
+givenName: Emacs
+mail: emacs-ert-test-1@ldap.gnu.org
+structuralObjectClass: OpenLDAPperson
+entryUUID: 43dd805e-fc0d-103c-8d5d-7dbac5615d14
+creatorsName:
+createTimestamp: 20221119042038Z
+entryCSN: 20221119042038.100350Z#000000#000#000000
+modifiersName:
+modifyTimestamp: 20221119042038Z
diff --git
a/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-2.ldif
b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-2.ldif
new file mode 100644
index 0000000000..d3de3d81c7
--- /dev/null
+++ b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-2.ldif
@@ -0,0 +1,17 @@
+# AUTO-GENERATED FILE - DO NOT EDIT!! Use ldapmodify.
+# CRC32 56119237
+dn: cn=emacs-ert-test-2
+objectClass: OpenLDAPperson
+cn: emacs-ert-test-2
+description:: RW1hY3Mg
+uid: 2
+sn: ERT2
+givenName: Emacs
+mail: emacs-ert-test-2@ldap.gnu.org
+structuralObjectClass: OpenLDAPperson
+entryUUID: 43dd92b0-fc0d-103c-8d5e-7dbac5615d14
+creatorsName:
+createTimestamp: 20221119042038Z
+entryCSN: 20221119042038.100819Z#000000#000#000000
+modifiersName:
+modifyTimestamp: 20221119042038Z
diff --git a/test/lisp/net/eudc-resources/ecompleterc
b/test/lisp/net/eudc-resources/ecompleterc
new file mode 100644
index 0000000000..9019b26c9f
--- /dev/null
+++ b/test/lisp/net/eudc-resources/ecompleterc
@@ -0,0 +1,7 @@
+((mail
+ ("larsi@gnus.org" 38154 1516109510 "Lars Ingebrigtsen <larsi@ecomplete.org>")
+ ("kfogel@red-bean.com" 10 1516065455 "Karl Fogel <kfogel@ecomplete.com>")
+ ("behse@ecomplete.org" 10 1516065455 "behse@ecomplete.org"))
+ (phone
+ ("Lars Ingebrigtsen" 0 0 "+1 234 5678 9012")
+ ("Karl Fogel" 0 0 "+33 701 4567 8901")))
diff --git a/test/lisp/net/eudc-resources/mailrc
b/test/lisp/net/eudc-resources/mailrc
new file mode 100644
index 0000000000..c565f71837
--- /dev/null
+++ b/test/lisp/net/eudc-resources/mailrc
@@ -0,0 +1,3 @@
+alias lars "Lars Ingebrigtsen <larsi@mail-abbrev.com>"
+alias karl "Karl Fogel <kfogel@mail-abbrev.com>"
+alias emacsheroes lars karl
diff --git a/test/lisp/net/eudc-resources/slapd.conf
b/test/lisp/net/eudc-resources/slapd.conf
new file mode 100644
index 0000000000..9afafe7676
--- /dev/null
+++ b/test/lisp/net/eudc-resources/slapd.conf
@@ -0,0 +1,7 @@
+include /etc/ldap/schema/core.schema
+include /etc/ldap/schema/cosine.schema
+include /etc/ldap/schema/inetorgperson.schema
+include /etc/ldap/schema/openldap.schema
+database ldif
+directory eudc-resources
+suffix "dc=gnu,dc=org"
diff --git a/test/lisp/net/eudc-tests.el b/test/lisp/net/eudc-tests.el
new file mode 100644
index 0000000000..212db65cb2
--- /dev/null
+++ b/test/lisp/net/eudc-tests.el
@@ -0,0 +1,311 @@
+;;; eudc-tests.el --- tests for eudc.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 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 'eudc)
+
+(ert-deftest eudc--plist-member ()
+ "Test `eudc--plist-member' behavior."
+ (dolist (obj '(a (a . a) (a a . a)))
+ (should-error (eudc--plist-member obj nil) :type 'wrong-type-argument))
+ (dolist (plist '((nil) (a) (a a a)))
+ (let ((err `(wrong-type-argument plistp ,(copy-sequence plist))))
+ (dolist (key '(nil a))
+ (should (equal err (should-error (eudc--plist-member plist key)))))))
+ (let ((-nil (string ?n ?i ?l))
+ (-a (string ?a)))
+ (should-not (eudc--plist-member () nil))
+ (should-not (eudc--plist-member () 'a))
+ (should-not (eudc--plist-member '(nil nil) 'a))
+ (should-not (eudc--plist-member '(nil a) 'a))
+ (should-not (eudc--plist-member '(a nil) nil))
+ (should-not (eudc--plist-member '(a a) nil))
+ (should-not (eudc--plist-member '("nil" a) nil))
+ (should-not (eudc--plist-member '("nil" a) -nil))
+ (should-not (eudc--plist-member '("a" a) nil))
+ (should-not (eudc--plist-member '("a" a) -a))
+ (should-not (eudc--plist-member '(nil a nil a) 'a))
+ (should-not (eudc--plist-member '(nil a "a" a) -a))
+ (should (equal (eudc--plist-member '(nil nil) nil) '(nil nil)))
+ (should (equal (eudc--plist-member '(nil a) nil) '(nil a)))
+ (should (equal (eudc--plist-member '(a nil) 'a) '(a nil)))
+ (should (equal (eudc--plist-member '(a a) 'a) '(a a)))
+ (should (equal (eudc--plist-member '(nil nil a nil) 'a) '(a nil)))
+ (should (equal (eudc--plist-member '(nil a a a) 'a) '(a a)))
+ (should (equal (eudc--plist-member '(a a a a) 'a) '(a a a a)))))
+
+(ert-deftest eudc-plist-member ()
+ "Test `eudc-plist-member' behavior."
+ (dolist (obj '(a (a . a) (a a . a)))
+ (should-error (eudc-plist-member obj nil) :type 'wrong-type-argument))
+ (dolist (plist '((nil) (a) (a a a)))
+ (let ((err `(wrong-type-argument plistp ,(copy-sequence plist))))
+ (dolist (key '(nil a))
+ (should (equal err (should-error (eudc-plist-member plist key)))))))
+ (let ((-nil (string ?n ?i ?l))
+ (-a (string ?a)))
+ (should-not (eudc-plist-member () nil))
+ (should-not (eudc-plist-member () 'a))
+ (should-not (eudc-plist-member '(nil nil) 'a))
+ (should-not (eudc-plist-member '(nil a) 'a))
+ (should-not (eudc-plist-member '(a nil) nil))
+ (should-not (eudc-plist-member '(a a) nil))
+ (should-not (eudc-plist-member '("nil" a) nil))
+ (should-not (eudc-plist-member '("nil" a) -nil))
+ (should-not (eudc-plist-member '("a" a) nil))
+ (should-not (eudc-plist-member '("a" a) -a))
+ (should-not (eudc-plist-member '(nil a nil a) 'a))
+ (should-not (eudc-plist-member '(nil a "a" a) -a))
+ (should (eq t (eudc-plist-member '(nil nil) nil)))
+ (should (eq t (eudc-plist-member '(nil a) nil)))
+ (should (eq t (eudc-plist-member '(a nil) 'a)))
+ (should (eq t (eudc-plist-member '(a a) 'a)))
+ (should (eq t (eudc-plist-member '(nil nil a nil) 'a)))
+ (should (eq t (eudc-plist-member '(nil a a a) 'a)))
+ (should (eq t (eudc-plist-member '(a a a a) 'a)))))
+
+(ert-deftest eudc-plist-get ()
+ "Test `eudc-plist-get' behavior."
+ (dolist (obj '(a (a . a) (a a . a)))
+ (should-error (eudc-plist-get obj nil) :type 'wrong-type-argument))
+ (dolist (plist '((nil) (a) (a a a)))
+ (let ((err `(wrong-type-argument plistp ,(copy-sequence plist))))
+ (dolist (key '(nil a))
+ (should (equal err (should-error (eudc-plist-get plist key)))))))
+ (let ((-nil (string ?n ?i ?l))
+ (-a (string ?a)))
+ (should-not (eudc-plist-get () nil))
+ (should-not (eudc-plist-get () 'a))
+ (should-not (eudc-plist-get '(nil nil) nil))
+ (should-not (eudc-plist-get '(nil nil) 'a))
+ (should-not (eudc-plist-get '(nil a) 'a))
+ (should-not (eudc-plist-get '(a nil) nil))
+ (should-not (eudc-plist-get '(a nil) 'a))
+ (should-not (eudc-plist-get '(a a) nil))
+ (should-not (eudc-plist-get '("nil" a) nil))
+ (should-not (eudc-plist-get '("nil" a) -nil))
+ (should-not (eudc-plist-get '("a" a) nil))
+ (should-not (eudc-plist-get '("a" a) -a))
+ (should-not (eudc-plist-get '(nil nil nil a) nil))
+ (should-not (eudc-plist-get '(nil a nil a) 'a))
+ (should-not (eudc-plist-get '(nil a "a" a) -a))
+ (should-not (eudc-plist-get '(a nil a a) 'a))
+ (should (eq 'a (eudc-plist-get '(nil a) nil)))
+ (should (eq 'a (eudc-plist-get '(a a) 'a)))
+ (should (eq 'a (eudc-plist-get '(a a a nil) 'a)))
+ (should (eq 'b (eudc-plist-get () nil 'b)))
+ (should (eq 'b (eudc-plist-get () 'a 'b)))
+ (should (eq 'b (eudc-plist-get '(nil a "a" a) -a 'b)))
+ (should (eq 'b (eudc-plist-get '(a nil "nil" nil) -nil 'b)))))
+
+(ert-deftest eudc-lax-plist-get ()
+ "Test `eudc-lax-plist-get' behavior."
+ (dolist (obj '(a (a . a) (a a . a)))
+ (should-error (eudc-lax-plist-get obj nil) :type 'wrong-type-argument))
+ (dolist (plist '((nil) (a) (a a a)))
+ (let ((err `(wrong-type-argument plistp ,(copy-sequence plist))))
+ (dolist (key '(nil a))
+ (should (equal err (should-error (eudc-lax-plist-get plist key)))))))
+ (let ((-nil (string ?n ?i ?l))
+ (-a (string ?a)))
+ (should-not (eudc-lax-plist-get () nil))
+ (should-not (eudc-lax-plist-get () 'a))
+ (should-not (eudc-lax-plist-get '(nil nil) nil))
+ (should-not (eudc-lax-plist-get '(nil nil) 'a))
+ (should-not (eudc-lax-plist-get '(nil a) 'a))
+ (should-not (eudc-lax-plist-get '(a nil) nil))
+ (should-not (eudc-lax-plist-get '(a nil) 'a))
+ (should-not (eudc-lax-plist-get '(a a) nil))
+ (should-not (eudc-lax-plist-get '("nil" a) nil))
+ (should-not (eudc-lax-plist-get '("nil" a) 'a))
+ (should-not (eudc-lax-plist-get '("a" a) nil))
+ (should-not (eudc-lax-plist-get '("a" a) 'a))
+ (should-not (eudc-lax-plist-get '(nil nil nil a) nil))
+ (should-not (eudc-lax-plist-get '(nil a nil a) 'a))
+ (should-not (eudc-lax-plist-get '(nil a "a" a) 'a))
+ (should-not (eudc-lax-plist-get '(a nil a a) 'a))
+ (should (eq 'a (eudc-lax-plist-get '(nil a) nil)))
+ (should (eq 'a (eudc-lax-plist-get '(a a) 'a)))
+ (should (eq 'a (eudc-lax-plist-get '(a a a nil) 'a)))
+ (should (eq 'b (eudc-lax-plist-get () nil 'b)))
+ (should (eq 'b (eudc-lax-plist-get () 'a 'b)))
+ (should (eq 'a (eudc-lax-plist-get '("nil" a) -nil)))
+ (should (eq 'a (eudc-lax-plist-get '("a" a) -a)))
+ (should (eq 'a (eudc-lax-plist-get '(nil a "a" a) -a)))
+ (should (eq 'b (eudc-lax-plist-get '(nil a "a" a) 'a 'b)))
+ (should (eq 'b (eudc-lax-plist-get '(a nil "nil" nil) nil 'b)))))
+
+;; eudc-rfc5322-quote-phrase (string)
+(ert-deftest eudc-test-rfc5322-quote-phrase ()
+ "Tests for RFC5322 compliant phrase quoting."
+ ;; atext-token "[:alpha:][:digit:]!#$%&'*+/=?^_`{|}~-"
+ (should (equal (eudc-rfc5322-quote-phrase "Foo Bar !#$%&'*+/=?^_`{|}~-")
+ "Foo Bar !#$%&'*+/=?^_`{|}~-"))
+ (should (equal (eudc-rfc5322-quote-phrase "Foo, Bar !#$%&'*+/=?^_`{|}~-")
+ "\"Foo, Bar !#$%&'*+/=?^_`{|}~-\"")))
+
+;; eudc-rfc5322-valid-comment-p (string)
+(ert-deftest eudc-test-rfc5322-valid-comment-p ()
+ "Tests for RFC5322 compliant comments."
+ ;; cctext-token "\u005D-\u007E\u002A-\u005B\u0021-\u0027" + fwsp-token (TAB,
LF, SPC)
+ ;; Printable US-ASCII characters not including "(", ")", or "\".
+ (let ((good-chars (append (number-sequence #x09 #x0a)
+ (number-sequence #x20 #x20)
+ (number-sequence #x21 #x27)
+ (number-sequence #x2a #x5b)
+ (number-sequence #x5d #x7e)))
+ (bad-chars (append (number-sequence #x00 #x08)
+ (number-sequence #x0b #x1f)
+ (number-sequence #x28 #x29)
+ (number-sequence #x5c #x5c)
+ (number-sequence #x7f #xff))))
+ (dolist (gc good-chars)
+ (should (eq (eudc-rfc5322-valid-comment-p (format "%c" gc)) t)))
+ (dolist (bc bad-chars)
+ (should (eq (eudc-rfc5322-valid-comment-p (format "%c" bc)) nil)))))
+
+;; eudc-rfc5322-make-address (address &optional firstname name comment)
+(ert-deftest eudc-test-make-address ()
+ "Tests for RFC5322 compliant email address formatting."
+ (should (equal (eudc-rfc5322-make-address "")
+ nil))
+ (should (equal (eudc-rfc5322-make-address nil)
+ nil))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org")
+ "j.sixpack@example.org"))
+ (should (equal (eudc-rfc5322-make-address "<j.sixpack@example.org>")
+ "<j.sixpack@example.org>"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ "Joey")
+ "Joey <j.sixpack@example.org>"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ "Joey"
+ "Sixpack")
+ "Joey Sixpack <j.sixpack@example.org>"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ "Joey"
+ "Sixpack"
+ "ten-packs are fine, too")
+ "Joey Sixpack <j.sixpack@example.org> \
+(ten-packs are fine, too)"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ ""
+ "Sixpack, Joey")
+ "\"Sixpack, Joey\" <j.sixpack@example.org>"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ nil
+ "Sixpack, Joey")
+ "\"Sixpack, Joey\" <j.sixpack@example.org>"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ nil
+ nil
+ "Duh!")
+ "j.sixpack@example.org (Duh!)"))
+ (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org"
+ nil
+ nil
+ "Duh\\!")
+ "j.sixpack@example.org")))
+
+(require 'ert-x) ; ert-with-temp-directory
+
+(defvar ecomplete-database-file (ert-resource-file "ecompleterc"))
+
+(ert-deftest eudcb-ecomplete ()
+ "Test the ecomplete back-end."
+ (ert-with-temp-directory home
+ (with-environment-variables (("HOME" home))
+ (let ((eudc-ignore-options-file t))
+ (should (equal (eudc-ecomplete-query-internal '((mail . "brigts")))
+ '(((mail . "Lars Ingebrigtsen
<larsi@ecomplete.org>")))))
+ (should (equal (eudc-ecomplete-query-internal '((mail . "karl")))
+ '(((mail . "Karl Fogel <kfogel@ecomplete.com>")))))
+ (should (equal (eudc-ecomplete-query-internal '((mail . "behs")))
+ '(((mail . "behse@ecomplete.org")))))
+ (should (equal (eudc-ecomplete-query-internal '((mail . "louie")))
+ nil))))))
+
+(ert-with-temp-directory
+ home
+ (ert-deftest eudcb-mailabbrev ()
+ "Test the mailabbrev back-end."
+ (with-environment-variables
+ (("HOME" home))
+ (let ((mail-personal-alias-file (ert-resource-file "mailrc"))
+ (eudc-ignore-options-file t))
+ (should (equal (eudc-mailabbrev-query-internal '((email . "lars")))
+ '(((email . "larsi@mail-abbrev.com")
+ (name . "Lars Ingebrigtsen")))))
+ (should (equal (eudc-mailabbrev-query-internal '((name . "lars")))
+ '(((email . "larsi@mail-abbrev.com")
+ (name . "Lars Ingebrigtsen")))))
+ (should (equal (eudc-mailabbrev-query-internal '((phone . "lars")))
+ nil))
+ (should (equal (eudc-mailabbrev-query-internal '((firstname . "karl")))
+ '(((email . "kfogel@mail-abbrev.com")
+ (name . "Karl Fogel")))))
+ (should (equal (eudc-mailabbrev-query-internal '((email . "louie")))
+ nil))
+ (should (equal (eudc-mailabbrev-query-internal '((name . "emacsheroes")))
+ '(((email . "Lars Ingebrigtsen <larsi@mail-abbrev.com>, \
+Karl Fogel <kfogel@mail-abbrev.com")))))))))
+
+(require 'ldap)
+(ert-deftest eudcb-ldap ()
+ "Test the LDAP back-end."
+ (skip-unless (and (file-exists-p "/usr/sbin/slapd")
+ (file-exists-p "/usr/bin/ldapsearch")))
+ (cd (concat (ert-resource-directory) ".."))
+ (let ((ldap-process
+ (start-process "slapd" "*slapd*" "/usr/sbin/slapd"
+ "-h" "ldap://127.0.0.1:3899"; "-d" "0" "-4"
+ "-f" (ert-resource-file "slapd.conf")))
+ (ldap-host-parameters-alist '(("ldap://localhost:3899";
+ base "dc=gnu,dc=org" auth simple)))
+ (eudc-server-hotlist '(("ldap://localhost:3899"; . ldap)))
+ (eudc-ignore-options-file t))
+ (sleep-for 1) ; Wait for slapd to start.
+ (should (equal (with-temp-buffer
+ (insert "emacs-ert-test-1")
+ (eudc-expand-try-all)
+ (buffer-string))
+ "Emacs ERT1 <emacs-ert-test-1@ldap.gnu.org>"))
+ (kill-process ldap-process)))
+
+(eval-and-compile
+ (push (expand-file-name "../elpa/packages/bbdb/lisp" source-directory)
+ load-path)
+ (defvar bbdb-file)
+ (require 'bbdb nil t))
+
+(ert-deftest eudcb-bbdb ()
+ "Test the BBDB back-end."
+ (skip-unless (featurep 'bbdb))
+ (let ((bbdb-file (ert-resource-file "bbdb"))
+ (eudc-server-hotlist '(("" . bbdb)))
+ (eudc-ignore-options-file t))
+ (should (equal (with-temp-buffer
+ (insert "emacs-ert-test-3")
+ (eudc-expand-try-all)
+ (buffer-string))
+ "Emacs ERT3 <emacs-ert-test-3@bbdb.gnu.org>"))))
+
+(provide 'eudc-tests)
+;;; eudc-tests.el ends here
diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el
index 9e60a243b3..04462dbc8b 100644
--- a/test/lisp/net/mailcap-tests.el
+++ b/test/lisp/net/mailcap-tests.el
@@ -125,7 +125,7 @@
(ert-deftest mailcap-view-file ()
(with-pristine-mailcap
- ;; Try using a lambda as viewer and check wether
+ ;; Try using a lambda as viewer and check whether
;; `mailcap-view-file' works correctly.
(let* ((mailcap-mime-extensions '((".test" . "test/test"))))
(mailcap-add "test/test" 'mailcap--test-viewer)
diff --git a/test/lisp/net/puny-resources/IdnaTestV2.txt
b/test/lisp/net/puny-resources/IdnaTestV2.txt
index ed2f32e129..4b8d5984a7 100644
--- a/test/lisp/net/puny-resources/IdnaTestV2.txt
+++ b/test/lisp/net/puny-resources/IdnaTestV2.txt
@@ -2,12 +2,12 @@
# Date: 2021-08-17, 19:34:01 GMT
# © 2021 Unicode®, Inc.
# Unicode and the Unicode Logo are registered trademarks of Unicode, Inc. in
the U.S. and other countries.
-# For terms of use, see http://www.unicode.org/terms_of_use.html
+# For terms of use, see https://www.unicode.org/terms_of_use.html
#
# Unicode IDNA Compatible Preprocessing for UTS #46
# Version: 14.0.0
#
-# For documentation and usage, see http://www.unicode.org/reports/tr46
+# For documentation and usage, see https://www.unicode.org/reports/tr46
#
# Test cases for verifying UTS #46 conformance.
#
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 2db4449438..a5bae46a58 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -140,10 +140,11 @@ A resource file is in the resource directory as per
((eq system-type 'windows-nt) null-device)
(t (add-to-list
'tramp-methods
- '("mock"
- (tramp-login-program "sh")
+ `("mock"
+ (tramp-login-program ,tramp-default-remote-shell)
(tramp-login-args (("-i")))
- (tramp-remote-shell "/bin/sh")
+ (tramp-direct-async ("-c"))
+ (tramp-remote-shell ,tramp-default-remote-shell)
(tramp-remote-shell-args ("-c"))
(tramp-connection-timeout 10)))
(add-to-list
@@ -4616,10 +4617,13 @@ This tests also `make-symbolic-link', `file-truename'
and `add-name-to-file'."
(load tmp-name 'noerror 'nomessage))
(should-not (featurep 'tramp-test-load))
(write-region "(provide 'tramp-test-load)" nil tmp-name)
- ;; `load' in lread.c does not pass `must-suffix'. Why?
- ;;(should-error
- ;; (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
- ;; :type 'file-error)
+ ;; `load' in lread.c passes `must-suffix' since Emacs 29.
+ ;; In Ange-FTP, `must-suffix' is ignored.
+ (when (and (tramp--test-emacs29-p)
+ (not (tramp--test-ange-ftp-p)))
+ (should-error
+ (load tmp-name nil 'nomessage 'nosuffix 'must-suffix)
+ :type 'file-error))
(load tmp-name nil 'nomessage 'nosuffix)
(should (featurep 'tramp-test-load)))
diff --git a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
index bb3d4871a9..13d879bf76 100644
--- a/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
+++ b/test/lisp/progmodes/cperl-mode-resources/here-docs.pl
@@ -140,4 +140,70 @@ HERE
. 'indent-level'; # Continuation, should be indented
+=head2 Test case 7
+
+An indented HERE document using a bare identifier.
+
+=cut
+
+## test case
+
+$text = <<~HERE;
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 8
+
+A HERE document as an argument to print when printing to a filehandle.
+
+=cut
+
+## test case
+
+print $fh <<~HERE;
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 9
+
+A HERE document as a hash value.
+
+=cut
+
+my %foo = (
+ text => <<~HERE
+look-here
+HERE
+ );
+
+$noindent = "New statement in this line";
+
+=head2 Test case 10
+
+A HERE document as an argument to die.
+
+=cut
+
+1 or die <<HERE;
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
+=head2 Test case 11
+
+A HERE document as an argument to warn.
+
+=cut
+
+1 or warn <<HERE;
+look-here
+HERE
+
+$noindent = "New statement in this line";
+
__END__
diff --git a/test/lisp/progmodes/python-tests.el
b/test/lisp/progmodes/python-tests.el
index fdaedb5fd7..f871b7bc7d 100644
--- a/test/lisp/progmodes/python-tests.el
+++ b/test/lisp/progmodes/python-tests.el
@@ -43,6 +43,34 @@ always located at the beginning of buffer."
(goto-char (point-min))
,@body)))
+(defun python-tests-shell-wait-for-prompt ()
+ "Wait for the prompt in the shell buffer."
+ (python-shell-with-shell-buffer
+ (while (not (python-util-comint-end-of-output-p))
+ (sit-for 0.1))))
+
+(defmacro python-tests-with-temp-buffer-with-shell (contents &rest body)
+ "Create a `python-mode' enabled temp buffer with CONTENTS and `run-python'.
+BODY is code to be executed within the temp buffer. Point is
+always located at the beginning of buffer. Native completion is
+turned off. Shell buffer will be killed on exit."
+ (declare (indent 1) (debug t))
+ `(with-temp-buffer
+ (let ((python-indent-guess-indent-offset nil)
+ (python-shell-completion-native-enable nil))
+ (python-mode)
+ (unwind-protect
+ (progn
+ (run-python nil t)
+ (insert ,contents)
+ (goto-char (point-min))
+ (python-tests-shell-wait-for-prompt)
+ ,@body)
+ (when (python-shell-get-buffer)
+ (python-shell-with-shell-buffer
+ (let (kill-buffer-hook kill-buffer-query-functions)
+ (kill-buffer))))))))
+
(defmacro python-tests-with-temp-file (contents &rest body)
"Create a `python-mode' enabled file with CONTENTS.
BODY is code to be executed within the temp buffer. Point is
@@ -4365,6 +4393,32 @@ def foo():
(python-shell-interpreter "/some/path/to/bin/pypy"))
(should (python-shell-completion-native-interpreter-disabled-p))))
+(ert-deftest python-shell-completion-at-point-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ ""
+ (python-shell-with-shell-buffer
+ (insert "import abc")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "abc.")
+ (should (nth 2 (python-shell-completion-at-point)))
+ (end-of-line 0)
+ (should-not (nth 2 (python-shell-completion-at-point))))))
+
+(ert-deftest python-shell-completion-at-point-native-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ ""
+ (python-shell-completion-native-turn-on)
+ (python-shell-with-shell-buffer
+ (insert "import abc")
+ (comint-send-input)
+ (python-tests-shell-wait-for-prompt)
+ (insert "abc.")
+ (should (nth 2 (python-shell-completion-at-point)))
+ (end-of-line 0)
+ (should-not (nth 2 (python-shell-completion-at-point))))))
@@ -4373,6 +4427,134 @@ def foo():
;;; Symbol completion
+(ert-deftest python-completion-at-point-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (goto-char (point-max))
+ (insert "abc.")
+ (should (completion-at-point))
+ (insert "A")
+ (should (completion-at-point)))))
+
+(ert-deftest python-completion-at-point-2 ()
+ "Should work regardless of the point in the Shell buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (python-shell-with-shell-buffer
+ (goto-char (point-min)))
+ (goto-char (point-max))
+ (insert "abc.")
+ (should (completion-at-point)))))
+
+(ert-deftest python-completion-at-point-pdb-1 ()
+ "Should not complete PDB commands in Python buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import pdb
+
+pdb.set_trace()
+print('Hello')
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (goto-char (point-max))
+ (insert "u")
+ (should-not (nth 2 (python-completion-at-point))))))
+
+(ert-deftest python-completion-at-point-while-running-1 ()
+ "Should not try to complete when a program is running in the Shell buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import time
+
+time.sleep(3)
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (goto-char (point-max))
+ (insert "time.")
+ (should-not (with-timeout (1 t) (completion-at-point))))))
+
+(ert-deftest python-completion-at-point-native-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-completion-native-turn-on)
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (goto-char (point-max))
+ (insert "abc.")
+ (should (completion-at-point))
+ (insert "A")
+ (should (completion-at-point)))))
+
+(ert-deftest python-completion-at-point-native-2 ()
+ "Should work regardless of the point in the Shell buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-completion-native-turn-on)
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (python-shell-with-shell-buffer
+ (goto-char (point-min)))
+ (goto-char (point-max))
+ (insert "abc.")
+ (should (completion-at-point)))))
+
+(ert-deftest python-completion-at-point-native-with-ffap-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-completion-native-turn-on)
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (goto-char (point-max))
+ (insert "abc.")
+ ;; This is called when FFAP is enabled and a find-file function is called.
+ (python-ffap-module-path "abc.")
+ (should (completion-at-point)))))
+
+(ert-deftest python-completion-at-point-native-with-eldoc-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-completion-native-turn-on)
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (goto-char (point-max))
+ (insert "abc.")
+ ;; This is called by idle-timer when ElDoc is enabled.
+ (python-eldoc-function)
+ (should (completion-at-point)))))
+
;;; Fill paragraph
@@ -4382,6 +4564,31 @@ def foo():
;;; FFAP
+(ert-deftest python-ffap-module-path-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (should (file-exists-p (python-ffap-module-path "abc"))))))
+
+(ert-deftest python-ffap-module-path-while-running-1 ()
+ "Should not get module path when a program is running in the Shell buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import abc
+import time
+
+time.sleep(3)
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (should-not (with-timeout (1 t) (python-ffap-module-path "abc"))))))
+
;;; Code check
@@ -4445,6 +4652,32 @@ some_symbol some_other_symbol
(should (string= (python-eldoc--get-symbol-at-point)
"some_symbol"))))
+(ert-deftest python-eldoc--get-doc-at-point-1 ()
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import time
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (python-tests-shell-wait-for-prompt)
+ (python-tests-look-at "time")
+ (should (python-eldoc--get-doc-at-point)))))
+
+(ert-deftest python-eldoc--get-doc-at-point-while-running-1 ()
+ "Should not get documentation when a program is running in the Shell buffer."
+ (skip-unless (executable-find python-tests-shell-interpreter))
+ (python-tests-with-temp-buffer-with-shell
+ "
+import time
+
+time.sleep(3)
+"
+ (let ((inhibit-message t))
+ (python-shell-send-buffer)
+ (python-tests-look-at "time")
+ (should-not (with-timeout (1 t) (python-eldoc--get-doc-at-point))))))
+
;;; Imenu
@@ -5359,6 +5592,23 @@ else:
(equal (list (python-tests-look-at "else:" -1 t))
(python-info-dedenter-opening-block-positions)))))
+(ert-deftest python-info-dedenter-opening-block-positions-6 ()
+ "Test multiline block start."
+ (python-tests-with-temp-buffer
+ "
+def func():
+ if (
+ cond1 or
+ cond2
+ ):
+ something()
+ else
+"
+ (python-tests-look-at "else\n")
+ (should
+ (equal (list (python-tests-look-at "if (" -1 t))
+ (python-info-dedenter-opening-block-positions)))))
+
(ert-deftest python-info-dedenter-opening-block-message-1 ()
"Test dedenters inside strings are ignored."
(python-tests-with-temp-buffer
diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
index 0c206b1e0c..f39489071e 100644
--- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb
+++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb
@@ -177,11 +177,11 @@ qux :+,
b = $:
c = ??
-# Example from http://www.ruby-doc.org/docs/ProgrammingRuby/html/language.html
+# Example from https://ruby-doc.com/docs/ProgrammingRuby/
d = 4 + 5 + # no '\' needed
6 + 7
-# Example from http://www.ruby-doc.org/docs/ProgrammingRuby/html/language.html
+# Example from https://www.ruby-doc.org/docs/ProgrammingRuby/
e = 8 + 9 \
+ 10 # '\' needed
diff --git a/test/lisp/server-tests.el b/test/lisp/server-tests.el
new file mode 100644
index 0000000000..351b8ef8d1
--- /dev/null
+++ b/test/lisp/server-tests.el
@@ -0,0 +1,41 @@
+;;; server-tests.el --- Emacs server test suite -*- lexical-binding:t -*-
+
+;; Copyright (C) 2022 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 'server)
+
+;;; Tests:
+
+(ert-deftest server-test/server-start-sets-minor-mode ()
+ "Ensure that calling `server-start' also sets `server-mode' properly."
+ (server-start)
+ (unwind-protect
+ (progn
+ ;; Make sure starting the server activates the minor mode.
+ (should (eq server-mode t))
+ (should (memq 'server-mode global-minor-modes)))
+ ;; Always stop the server, even if the above checks fail.
+ (server-start t))
+ ;; Make sure stopping the server deactivates the minor mode.
+ (should (eq server-mode nil))
+ (should-not (memq 'server-mode global-minor-modes)))
+
+;;; server-tests.el ends here
diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el
index 97f425f6f4..6e48f11fc0 100644
--- a/test/lisp/simple-tests.el
+++ b/test/lisp/simple-tests.el
@@ -73,6 +73,30 @@
(should (= (count-lines (point) (point)) 0))))
+;;; `execute-extended-command'
+
+(ert-deftest simple-execute-extended-command--shorter ()
+ ;; This test can be flaky with completion frameworks other than the
+ ;; default, so just skip it in interactive sessions.
+ (skip-unless noninteractive)
+ (should (equal (execute-extended-command--shorter
+ "display-line-numbers-mode"
+ "display-line")
+ "di-n")))
+
+(ert-deftest simple-execute-extended-command--describe-binding-msg ()
+ (let ((text-quoting-style 'grave))
+ (should (equal (execute-extended-command--describe-binding-msg
+ 'foo "m" nil)
+ "You can run the command `foo' with m"))
+ (should (equal (execute-extended-command--describe-binding-msg
+ 'foo [14] nil)
+ "You can run the command `foo' with C-n"))
+ (should (equal (execute-extended-command--describe-binding-msg
+ 'display-line-numbers-mode nil "di-n")
+ "You can run the command `display-line-numbers-mode' with
M-x di-n"))))
+
+
;;; `transpose-sexps'
(defmacro simple-test--transpositions (&rest body)
(declare (indent 0)
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 347981e818..e22d1c7be0 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -1106,7 +1106,7 @@ final or penultimate step during initialization."))
(ert-deftest test-keymap-parse-macros ()
(should (equal (key-parse "C-x ( C-d C-x )") [24 40 4 24 41]))
- (should (equal (kbd "C-x ( C-d C-x )") ""))
+ (should (equal (kbd "C-x ( C-d C-x )") "\^D"))
(should (equal (kbd "C-x ( C-x )") "")))
(defvar subr-test--global)
@@ -1139,7 +1139,10 @@ final or penultimate step during initialization."))
(should-not (plistp '(1 . 2)))
(should (plistp '(1 2 3 4)))
(should-not (plistp '(1 2 3)))
- (should-not (plistp '(1 2 3 . 4))))
+ (should-not (plistp '(1 2 3 . 4)))
+ (let ((cycle (list 1 2 3)))
+ (nconc cycle cycle)
+ (should-not (plistp cycle))))
(defun subr-tests--butlast-ref (list &optional n)
"Reference implementation of `butlast'."
diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el
index b6d0b1446a..67dd00104b 100644
--- a/test/lisp/thingatpt-tests.el
+++ b/test/lisp/thingatpt-tests.el
@@ -44,6 +44,9 @@
;; Non alphanumeric characters can be found in URIs
("ftp://example.net/~foo!;#bar=baz&goo=bob"; 3 url
"ftp://example.net/~foo!;#bar=baz&goo=bob";)
("bzr+ssh://user@example.net:5/a%20d,5" 34 url
"bzr+ssh://user@example.net:5/a%20d,5")
+ ;; IPv6 brackets enclosed in [markup]
+ ("[http://[::1]:8000/foo]"; 10 url "http://[::1]:8000/foo";)
+ ("[http://[fe08::7:8%eth0]]"; 10 url "http://[fe08::7:8%eth0]";)
;; <url:...> markup
("Url: <url:foo://1.example.com>..." 8 url "foo://1.example.com")
("Url: <url:foo://2.example.com>..." 30 url "foo://2.example.com")
diff --git a/test/lisp/time-stamp-tests.el b/test/lisp/time-stamp-tests.el
index 55e37b71d8..1b5ef04436 100644
--- a/test/lisp/time-stamp-tests.el
+++ b/test/lisp/time-stamp-tests.el
@@ -89,11 +89,11 @@
(iter-defun time-stamp-test-pattern-sequential ()
"Iterate through each possibility for a part of `time-stamp-pattern'."
(let ((pattern-value-parts
- '(("4/" "10/" "-4/" "0/" "") ;0: line limit
+ '(("4/" "10/" "-9/" "0/" "") ;0: line limit
("stamp<" "") ;1: start
- ("%-d" "%_H" "%^a" "%#Z" "%:A" "%02H" "%%" "") ;2: format part 1
+ ("%-d" "%_H" "%^a" "%#Z" "%:A" "%09z" "%%" "") ;2: format part 1
(" " "x" ":" "\n" "") ;3: format part 2
- ("%-d" "%_H" "%^a" "%#Z" "%:A" "%02H" "%%") ;4: format part 3
+ ("%-d" "%_H" "%^a" "%#Z" "%:A" "%09z" "%%") ;4: format part 3
(">end" "")))) ;5: end
(dotimes (cur (length pattern-value-parts))
(dotimes (cur-index (length (nth cur pattern-value-parts)))
@@ -118,7 +118,7 @@
(iter-defun time-stamp-test-pattern-multiply ()
"Iterate through every combination of parts of `time-stamp-pattern'."
(let ((line-limit-values '("" "4/"))
- (start-values '("" "stamp<"))
+ (start-values '("" "/stamp/"))
(format-values '("%%" "%m"))
(end-values '("" ">end")))
;; yield all combinations of the above
diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el
index dc4d3af699..13248a3650 100644
--- a/test/lisp/vc/vc-tests.el
+++ b/test/lisp/vc/vc-tests.el
@@ -127,7 +127,7 @@ Don't set it globally, the functions should be let-bound.")
(defun vc-test--create-repo-function (backend)
"Run the `vc-create-repo' backend function.
-For backends which dont support it, it is emulated."
+For backends which don't support it, it is emulated."
(cond
((eq backend 'CVS)
diff --git a/test/manual/image-circular-tests.el
b/test/manual/image-circular-tests.el
index 1299970f82..d2187cbbad 100644
--- a/test/manual/image-circular-tests.el
+++ b/test/manual/image-circular-tests.el
@@ -27,8 +27,11 @@
(require 'ert)
+(declare-function image-size "image.c" (spec &optional pixels frame))
+
(ert-deftest image-test-duplicate-keywords ()
"Test that duplicate keywords in an image spec lead to rejection."
+ (skip-unless (display-images-p))
(should-error (image-size `(image :type xbm :type xbm
:data-width 1 :data-height 1
:data ,(bool-vector t))
@@ -36,33 +39,37 @@
(ert-deftest image-test-circular-plist ()
"Test that a circular image spec is rejected."
- (should-error
- (let ((l `(image :type xbm :data-width 1 :data-height 1
- :data ,(bool-vector t))))
- (setcdr (last l) '#1=(:invalid . #1#))
- (image-size l t))))
+ (skip-unless (display-images-p))
+ (let ((spec `(image :type xbm :data-width 1 :data-height 1
+ :data ,(bool-vector t)
+ . ,'#1=(:invalid . #1#))))
+ (should-error (image-size spec t))))
(ert-deftest image-test-:type-property-value ()
"Test that :type is allowed as a property value in an image spec."
+ (skip-unless (display-images-p))
(should (equal (image-size `(image :dummy :type :type xbm
:data-width 1 :data-height 1
:data ,(bool-vector t))
t)
- (cons 1 1))))
+ '(1 . 1))))
(ert-deftest image-test-circular-specs ()
- "Test that circular image spec property values do not cause infinite
recursion."
- (should
- (let* ((circ1 (cons :dummy nil))
- (circ2 (cons :dummy nil))
- (spec1 `(image :type xbm :data-width 1 :data-height 1
- :data ,(bool-vector 1) :ignored ,circ1))
- (spec2 `(image :type xbm :data-width 1 :data-height 1
+ "Test with circular image spec property values.
+In particular, test that they do not cause infinite recursion."
+ :expected-result :failed ;; FIXME: bug#36403#63.
+ (skip-unless (display-images-p))
+ ;; Two copies needed to warm up image cache.
+ (let* ((circ1 (list :dummy))
+ (circ2 (list :dummy))
+ (spec1 `(image :type xbm :data-width 1 :data-height 1
+ :data ,(bool-vector 1) :ignored ,circ1))
+ (spec2 `(image :type xbm :data-width 1 :data-height 1
:data ,(bool-vector 1) :ignored ,circ2)))
- (setcdr circ1 circ1)
- (setcdr circ2 circ2)
- (and (equal (image-size spec1 t) (cons 1 1))
- (equal (image-size spec2 t) (cons 1 1))))))
+ (setcdr circ1 circ1)
+ (setcdr circ2 circ2)
+ (should (equal (image-size spec1 t) '(1 . 1)))
+ (should (equal (image-size spec2 t) '(1 . 1)))))
(provide 'image-circular-tests)
;;; image-circular-tests.el ends here.
diff --git a/test/manual/noverlay/.gitignore b/test/manual/noverlay/.gitignore
new file mode 100644
index 0000000000..ca7fc452b8
--- /dev/null
+++ b/test/manual/noverlay/.gitignore
@@ -0,0 +1 @@
+itree-tests
diff --git a/test/manual/noverlay/Makefile.in b/test/manual/noverlay/Makefile.in
new file mode 100644
index 0000000000..3c8dba1ce1
--- /dev/null
+++ b/test/manual/noverlay/Makefile.in
@@ -0,0 +1,47 @@
+### @configure_input@
+
+# Copyright (C) 2017-2022 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/>.
+
+PROGRAM = itree-tests
+PACKAGES = check
+top_srcdir = @top_srcdir@
+top_builddir = @top_builddir@
+CPPFLAGS += -I $(top_srcdir)/src
+CFLAGS += -O0 -g3 $(shell pkg-config --cflags $(PACKAGES))
+LDLIBS += $(shell pkg-config --libs $(PACKAGES)) -lm
+OBJECTS = itree-tests.o
+CC = gcc
+EMACS ?= $(top_builddir)/src/emacs
+
+.PHONY: all check clean distclean perf
+
+all: check
+
+check: $(PROGRAM)
+ ./check-sanitize.sh ./$(PROGRAM)
+
+itree-tests.o: emacs-compat.h $(top_srcdir)/src/itree.c
$(top_srcdir)/src/itree.h
+
+perf:
+ -$(EMACS) -Q -l ./overlay-perf.el -f perf-run-batch
+
+clean:
+ rm -f -- $(OBJECTS) $(PROGRAM)
+
+distclean: clean
+ rm -f -- Makefile
diff --git a/test/manual/noverlay/check-sanitize.sh
b/test/manual/noverlay/check-sanitize.sh
new file mode 100755
index 0000000000..9a67818dc8
--- /dev/null
+++ b/test/manual/noverlay/check-sanitize.sh
@@ -0,0 +1,33 @@
+#!/usr/bin/env bash
+### check-sanitize.sh - strip confusing parts of Check error output
+
+## Copyright (C) 2017-2022 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/>.
+
+set -o pipefail
+
+prog=$1
+shift
+
+[ -z "$prog" ] && {
+ echo "usage:$(basename $0) CHECK_PROGRAM";
+ exit 1;
+}
+
+# FIXME: This would be unnecessary if
+# compilation-error-regexp-alist-alist understood libcheck OOTB.
+"$prog" "$@" | sed -e
's/^\([^:]\+\):\([0-9]\+\):\([PFE]\):\([^:]*\):\([^:]*\):[^:]*:\(.*\)/\1:\2:\3:\4:\5:\6/'
diff --git a/test/manual/noverlay/emacs-compat.h
b/test/manual/noverlay/emacs-compat.h
new file mode 100644
index 0000000000..d2448b12db
--- /dev/null
+++ b/test/manual/noverlay/emacs-compat.h
@@ -0,0 +1,76 @@
+/* Mock necessary parts of lisp.h.
+
+Copyright (C) 2017-2022 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/>. */
+
+#ifndef TEST_COMPAT_H
+#define TEST_COMPAT_H
+
+#include <limits.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+typedef int Lisp_Object;
+
+void *
+xmalloc (size_t size)
+{
+ return malloc (size);
+}
+
+void
+xfree (void *ptr)
+{
+ free (ptr);
+}
+
+void *
+xrealloc (void *block, size_t size)
+{
+ return realloc (block, size);
+}
+
+void
+emacs_abort ()
+{
+ fprintf (stderr, "Aborting...\n");
+ exit (EXIT_FAILURE);
+}
+
+#ifndef eassert
+#define eassert(cond) \
+ do { \
+ if (! (cond)) { \
+ fprintf (stderr, "%s:%d:eassert condition failed: %s\n", \
+ __FILE__, __LINE__ , # cond); \
+ exit (EXIT_FAILURE); \
+ } \
+ } while (0)
+#endif
+
+#ifndef eassume
+#define eassume eassert
+#endif
+
+#ifndef max
+#define max(x,y) ((x) >= (y) ? (x) : (y))
+#endif
+#ifndef min
+#define min(x,y) ((x) <= (y) ? (x) : (y))
+#endif
+
+#endif /* TEST_COMPAT_H */
diff --git a/test/manual/noverlay/itree-tests.c
b/test/manual/noverlay/itree-tests.c
new file mode 100644
index 0000000000..278e65f9bf
--- /dev/null
+++ b/test/manual/noverlay/itree-tests.c
@@ -0,0 +1,1289 @@
+/* Test the interval data-structure in itree.c.
+
+Copyright (c) 2017-2022 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/>. */
+
+#include <config.h>
+
+#include <stdarg.h>
+#include <stdlib.h>
+
+#include <check.h>
+#include "emacs-compat.h"
+
+#define EMACS_LISP_H /* lisp.h inclusion guard */
+#define ITREE_DEBUG 1
+#define ITREE_TESTING
+#include "itree.c"
+
+/* Globals. */
+
+static struct itree_tree tree;
+static struct itree_node A, B, C, D, E;
+static struct itree_node N_05, N_10, N_15, N_20, N_30, N_40;
+static struct itree_node N_50, N_70, N_80, N_90, N_85, N_95;
+
+/* Basic tests of the itree_tree data-structure. */
+
+/*
+===================================================================================+
+ * | Insert
+ *
+===================================================================================+
*/
+
+/* The graphs below display the trees after each insertion (as they
+ should be). See the source code for the different cases
+ applied. */
+
+static void
+test_insert1_setup (void)
+{
+ enum { N = 6 };
+ const int values[N] = {50, 30, 20, 10, 15, 5};
+ struct itree_node *nodes[N] = {&N_50, &N_30, &N_20, &N_10, &N_15, &N_05};
+ interval_tree_init (&tree);
+ for (int i = 0; i < N; ++i)
+ {
+ nodes[i]->begin = nodes[i]->end = values[i];
+ nodes[i]->otick = tree.otick;
+ }
+}
+
+START_TEST (test_insert_1)
+{
+ /*
+ * [50]
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ ck_assert (! N_50.red);
+ ck_assert_ptr_eq (&N_50, tree.root);
+}
+END_TEST
+
+START_TEST (test_insert_2)
+{
+ /*
+ * [50]
+ * /
+ * (30)
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ ck_assert (! N_50.red);
+ ck_assert (N_30.red);
+ ck_assert_ptr_eq (&N_50, tree.root);
+ ck_assert_ptr_eq (N_30.parent, &N_50);
+ ck_assert_ptr_eq (N_50.left, &N_30);
+ ck_assert_ptr_null (N_50.right);
+ ck_assert_ptr_null (N_30.left);
+ ck_assert_ptr_null (N_30.right);
+}
+END_TEST
+
+START_TEST (test_insert_3)
+{
+ /* case 3.a
+ * [30]
+ * / \
+ * (20) (50)
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ interval_tree_insert (&tree, &N_20);
+ ck_assert (N_50.red);
+ ck_assert (! N_30.red);
+ ck_assert (N_20.red);
+ ck_assert_ptr_eq (&N_30, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_30);
+ ck_assert_ptr_eq (N_30.right, &N_50);
+ ck_assert_ptr_eq (N_30.left, &N_20);
+ ck_assert_ptr_null (N_20.left);
+ ck_assert_ptr_null (N_20.right);
+ ck_assert_ptr_eq (N_20.parent, &N_30);
+}
+END_TEST
+
+START_TEST (test_insert_4)
+{
+ /* 1.a
+ * [30]
+ * / \
+ * [20] [50]
+ * /
+ * (10)
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ interval_tree_insert (&tree, &N_20);
+ interval_tree_insert (&tree, &N_10);
+ ck_assert (! N_50.red);
+ ck_assert (! N_30.red);
+ ck_assert (! N_20.red);
+ ck_assert (N_10.red);
+ ck_assert_ptr_eq (&N_30, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_30);
+ ck_assert_ptr_eq (N_30.right, &N_50);
+ ck_assert_ptr_eq (N_30.left, &N_20);
+ ck_assert_ptr_eq (N_20.left, &N_10);
+ ck_assert_ptr_null (N_20.right);
+ ck_assert_ptr_eq (N_20.parent, &N_30);
+ ck_assert_ptr_eq (N_10.parent, &N_20);
+ ck_assert_ptr_eq (N_20.left, &N_10);
+ ck_assert_ptr_null (N_10.right);
+}
+END_TEST
+
+START_TEST (test_insert_5)
+{
+ /* 2.a
+ * [30]
+ * / \
+ * [15] [50]
+ * / \
+ * (10) (20)
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ interval_tree_insert (&tree, &N_20);
+ interval_tree_insert (&tree, &N_10);
+ interval_tree_insert (&tree, &N_15);
+ ck_assert (! N_50.red);
+ ck_assert (! N_30.red);
+ ck_assert (N_20.red);
+ ck_assert (N_10.red);
+ ck_assert (! N_15.red);
+ ck_assert_ptr_eq (&N_30, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_30);
+ ck_assert_ptr_eq (N_30.right, &N_50);
+ ck_assert_ptr_eq (N_30.left, &N_15);
+ ck_assert_ptr_null (N_20.left);
+ ck_assert_ptr_null (N_20.right);
+ ck_assert_ptr_eq (N_20.parent, &N_15);
+ ck_assert_ptr_eq (N_10.parent, &N_15);
+ ck_assert_ptr_null (N_20.left);
+ ck_assert_ptr_null (N_10.right);
+ ck_assert_ptr_eq (N_15.right, &N_20);
+ ck_assert_ptr_eq (N_15.left, &N_10);
+ ck_assert_ptr_eq (N_15.parent, &N_30);
+}
+END_TEST
+
+START_TEST (test_insert_6)
+{
+ /* 1.a
+ * [30]
+ * / \
+ * (15) [50]
+ * / \
+ * [10] [20]
+ * /
+ * (5)
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_30);
+ interval_tree_insert (&tree, &N_20);
+ interval_tree_insert (&tree, &N_10);
+ interval_tree_insert (&tree, &N_15);
+ interval_tree_insert (&tree, &N_05);
+ ck_assert (! N_50.red);
+ ck_assert (! N_30.red);
+ ck_assert (! N_20.red);
+ ck_assert (! N_10.red);
+ ck_assert (N_15.red);
+ ck_assert (N_05.red);
+ ck_assert_ptr_eq (&N_30, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_30);
+ ck_assert_ptr_eq (N_30.right, &N_50);
+ ck_assert_ptr_eq (N_30.left, &N_15);
+ ck_assert_ptr_null (N_20.left);
+ ck_assert_ptr_null (N_20.right);
+ ck_assert_ptr_eq (N_20.parent, &N_15);
+ ck_assert_ptr_eq (N_10.parent, &N_15);
+ ck_assert_ptr_null (N_20.left);
+ ck_assert_ptr_null (N_10.right);
+ ck_assert_ptr_eq (N_15.right, &N_20);
+ ck_assert_ptr_eq (N_15.left, &N_10);
+ ck_assert_ptr_eq (N_15.parent, &N_30);
+ ck_assert_ptr_eq (N_05.parent, &N_10);
+ ck_assert_ptr_eq (N_10.left, &N_05);
+ ck_assert_ptr_null (N_05.right);
+}
+END_TEST
+
+
+
+/* These are the mirror cases to the above ones. */
+
+static void
+test_insert2_setup (void)
+{
+ enum { N = 6 };
+ const int values[] = {50, 70, 80, 90, 85, 95};
+ struct itree_node *nodes[N] = {&N_50, &N_70, &N_80, &N_90, &N_85, &N_95};
+ interval_tree_init (&tree);
+ for (int i = 0; i < N; ++i)
+ {
+ nodes[i]->begin = nodes[i]->end = values[i];
+ nodes[i]->otick = tree.otick;
+ }
+}
+
+START_TEST (test_insert_7)
+{
+ /*
+ * [50]
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ ck_assert (! N_50.red);
+ ck_assert_ptr_eq (&N_50, tree.root);
+}
+END_TEST
+
+START_TEST (test_insert_8)
+{
+ /*
+ * [50]
+ * \
+ * (70)
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ ck_assert (! N_50.red);
+ ck_assert (N_70.red);
+ ck_assert_ptr_eq (&N_50, tree.root);
+ ck_assert_ptr_eq (N_70.parent, &N_50);
+ ck_assert_ptr_eq (N_50.right, &N_70);
+ ck_assert_ptr_null (N_50.left);
+ ck_assert_ptr_null (N_70.right);
+ ck_assert_ptr_null (N_70.left);
+}
+END_TEST
+
+START_TEST (test_insert_9)
+{
+ /* 3.a
+ * [70]
+ * / \
+ * (50) (80)
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ interval_tree_insert (&tree, &N_80);
+ ck_assert (N_50.red);
+ ck_assert (! N_70.red);
+ ck_assert (N_80.red);
+ ck_assert_ptr_eq (&N_70, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_70);
+ ck_assert_ptr_eq (N_70.right, &N_80);
+ ck_assert_ptr_eq (N_70.left, &N_50);
+ ck_assert_ptr_null (N_80.right);
+ ck_assert_ptr_null (N_80.left);
+ ck_assert_ptr_eq (N_80.parent, &N_70);
+}
+END_TEST
+
+START_TEST (test_insert_10)
+{
+ /* 1.b
+ * [70]
+ * / \
+ * [50] [80]
+ * \
+ * (90)
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ interval_tree_insert (&tree, &N_80);
+ interval_tree_insert (&tree, &N_90);
+ ck_assert (! N_50.red);
+ ck_assert (! N_70.red);
+ ck_assert (! N_80.red);
+ ck_assert (N_90.red);
+ ck_assert_ptr_eq (&N_70, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_70);
+ ck_assert_ptr_eq (N_70.right, &N_80);
+ ck_assert_ptr_eq (N_70.left, &N_50);
+ ck_assert_ptr_eq (N_80.right, &N_90);
+ ck_assert_ptr_null (N_80.left);
+ ck_assert_ptr_eq (N_80.parent, &N_70);
+ ck_assert_ptr_eq (N_90.parent, &N_80);
+ ck_assert_ptr_eq (N_80.right, &N_90);
+ ck_assert_ptr_null (N_90.left);
+}
+END_TEST
+
+START_TEST (test_insert_11)
+{
+ /* 2.b
+ * [70]
+ * / \
+ * [50] [85]
+ * / \
+ * (80) (90)
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ interval_tree_insert (&tree, &N_80);
+ interval_tree_insert (&tree, &N_90);
+ interval_tree_insert (&tree, &N_85);
+ ck_assert (! N_50.red);
+ ck_assert (! N_70.red);
+ ck_assert (N_80.red);
+ ck_assert (N_90.red);
+ ck_assert (! N_85.red);
+ ck_assert_ptr_eq (&N_70, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_70);
+ ck_assert_ptr_eq (N_70.right, &N_85);
+ ck_assert_ptr_eq (N_70.left, &N_50);
+ ck_assert_ptr_null (N_80.right);
+ ck_assert_ptr_null (N_80.left);
+ ck_assert_ptr_eq (N_80.parent, &N_85);
+ ck_assert_ptr_eq (N_90.parent, &N_85);
+ ck_assert_ptr_null (N_80.right);
+ ck_assert_ptr_null (N_90.left);
+ ck_assert_ptr_eq (N_85.right, &N_90);
+ ck_assert_ptr_eq (N_85.left, &N_80);
+ ck_assert_ptr_eq (N_85.parent, &N_70);
+
+}
+END_TEST
+
+START_TEST (test_insert_12)
+{
+ /* 1.b
+ * [70]
+ * / \
+ * [50] (85)
+ * / \
+ * [80] [90]
+ * \
+ * (95)
+ */
+
+ interval_tree_insert (&tree, &N_50);
+ interval_tree_insert (&tree, &N_70);
+ interval_tree_insert (&tree, &N_80);
+ interval_tree_insert (&tree, &N_90);
+ interval_tree_insert (&tree, &N_85);
+ interval_tree_insert (&tree, &N_95);
+ ck_assert (! N_50.red);
+ ck_assert (! N_70.red);
+ ck_assert (! N_80.red);
+ ck_assert (! N_90.red);
+ ck_assert (N_85.red);
+ ck_assert (N_95.red);
+ ck_assert_ptr_eq (&N_70, tree.root);
+ ck_assert_ptr_eq (N_50.parent, &N_70);
+ ck_assert_ptr_eq (N_70.right, &N_85);
+ ck_assert_ptr_eq (N_70.left, &N_50);
+ ck_assert_ptr_null (N_80.right);
+ ck_assert_ptr_null (N_80.left);
+ ck_assert_ptr_eq (N_80.parent, &N_85);
+ ck_assert_ptr_eq (N_90.parent, &N_85);
+ ck_assert_ptr_null (N_80.right);
+ ck_assert_ptr_null (N_90.left);
+ ck_assert_ptr_eq (N_85.right, &N_90);
+ ck_assert_ptr_eq (N_85.left, &N_80);
+ ck_assert_ptr_eq (N_85.parent, &N_70);
+ ck_assert_ptr_eq (N_95.parent, &N_90);
+ ck_assert_ptr_eq (N_90.right, &N_95);
+ ck_assert_ptr_null (N_95.left);
+}
+END_TEST
+
+START_TEST (test_insert_13)
+{
+ enum { N = 4 };
+ const int values[N] = {10, 20, 30, 40};
+ struct itree_node *nodes[N] = {&N_10, &N_20, &N_30, &N_40};
+ interval_tree_init (&tree);
+ for (int i = 0; i < N; ++i)
+ itree_insert (&tree, nodes[i], values[i], values[i]);
+
+ ck_assert_ptr_eq (tree.root, &N_20);
+ ck_assert_ptr_eq (N_20.left, &N_10);
+ ck_assert_ptr_eq (N_20.right, &N_30);
+ ck_assert_ptr_eq (N_30.right, &N_40);
+ ck_assert (! N_10.red);
+ ck_assert (! N_20.red);
+ ck_assert (! N_30.red);
+ ck_assert (N_40.red);
+}
+END_TEST
+
+START_TEST (test_insert_14)
+{
+ enum { N = 3 };
+ struct itree_node nodes[N];
+ interval_tree_init (&tree);
+
+ for (int i = 0; i < N; ++i)
+ itree_insert (&tree, &nodes[i], 10, 10);
+ for (int i = 0; i < N; ++i)
+ ck_assert (interval_tree_contains (&tree, &nodes[i]));
+}
+END_TEST
+
+
+/*
+===================================================================================+
+ * | Remove
+ *
+===================================================================================+
*/
+
+/* Creating proper test trees for the formal tests via insertions is
+ way too tedious, so we just fake it and only test the
+ fix-routine. */
+static void
+test_remove1_setup (void)
+{
+ interval_tree_init (&tree);
+ tree.root = &B;
+ A.parent = &B; B.parent = NULL; C.parent = &D; D.parent = &B; E.parent = &D;
+ A.left = A.right = C.left = C.right = E.left = E.right = NULL;
+ B.left = &A; B.right = &D;
+ D.left = &C; D.right = &E;
+ A.offset = B.offset = C.offset = D.offset = E.offset = 0;
+ A.otick = B.otick = C.otick = D.otick = E.otick = tree.otick;
+}
+
+/* 1.a -> 2.a
+ * [B]
+ * / \
+ * [A] (D)
+ * / \
+ * [C] [E]
+ */
+
+START_TEST (test_remove_1)
+{
+ B.red = A.red = C.red = E.red = false;
+ D.red = true;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.left, &A);
+ ck_assert_ptr_eq (B.right, &C);
+ ck_assert_ptr_eq (C.parent, &B);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (D.right, &E);
+ ck_assert_ptr_eq (D.left, &B);
+ ck_assert_ptr_eq (tree.root, &D);
+}
+END_TEST
+
+/* 2.a */
+START_TEST (test_remove_2)
+{
+ B.red = D.red = A.red = C.red = E.red = false;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (! C.red);
+ ck_assert (D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.left, &A);
+ ck_assert_ptr_eq (B.right, &D);
+ ck_assert_ptr_eq (C.parent, &D);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (tree.root, &B);
+}
+END_TEST
+
+/* 3.a -> 4.a */
+START_TEST (test_remove_3)
+{
+ D.red = A.red = E.red = false;
+ B.red = C.red = true;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (! C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.left, &A);
+ ck_assert_ptr_null (B.right);
+ ck_assert_ptr_eq (&C, tree.root);
+ ck_assert_ptr_eq (C.left, &B);
+ ck_assert_ptr_eq (C.right, &D);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_null (D.left);
+}
+END_TEST
+
+/* 4.a */
+START_TEST (test_remove_4)
+{
+ B.red = C.red = E.red = true;
+ A.red = D.red = false;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.left, &A);
+ ck_assert_ptr_eq (B.right, &C);
+ ck_assert_ptr_eq (C.parent, &B);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (tree.root, &D);
+}
+END_TEST
+
+
+
+/* These are the mirrored cases. */
+
+static void
+test_remove2_setup (void)
+{
+ interval_tree_init (&tree);
+ tree.root = &B;
+ A.parent = &B; B.parent = NULL; C.parent = &D; D.parent = &B; E.parent = &D;
+ A.right = A.left = C.right = C.left = E.right = E.left = NULL;
+ B.right = &A; B.left = &D;
+ D.right = &C; D.left = &E;
+}
+
+/* 1.b -> 2.b
+ * [B]
+ * / \
+ * [A] (D)
+ * / \
+ * [C] [E]
+ */
+
+START_TEST (test_remove_5)
+{
+ B.red = A.red = C.red = E.red = false;
+ D.red = true;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.right, &A);
+ ck_assert_ptr_eq (B.left, &C);
+ ck_assert_ptr_eq (C.parent, &B);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (D.left, &E);
+ ck_assert_ptr_eq (D.right, &B);
+ ck_assert_ptr_eq (tree.root, &D);
+}
+END_TEST
+
+/* 2.b */
+START_TEST (test_remove_6)
+{
+ B.red = D.red = A.red = C.red = E.red = false;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (! C.red);
+ ck_assert (D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.right, &A);
+ ck_assert_ptr_eq (B.left, &D);
+ ck_assert_ptr_eq (C.parent, &D);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (tree.root, &B);
+}
+END_TEST
+
+/* 3.b -> 4.b */
+START_TEST (test_remove_7)
+{
+ D.red = A.red = E.red = false;
+ B.red = C.red = true;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (! C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.right, &A);
+ ck_assert_ptr_null (B.left);
+ ck_assert_ptr_eq (&C, tree.root);
+ ck_assert_ptr_eq (C.right, &B);
+ ck_assert_ptr_eq (C.left, &D);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_null (D.right);
+}
+END_TEST
+
+/* 4.b */
+START_TEST (test_remove_8)
+{
+ B.red = C.red = E.red = true;
+ A.red = D.red = false;
+ interval_tree_remove_fix (&tree, &A, &B);
+
+ ck_assert (! A.red);
+ ck_assert (! B.red);
+ ck_assert (C.red);
+ ck_assert (! D.red);
+ ck_assert (! E.red);
+ ck_assert_ptr_eq (A.parent, &B);
+ ck_assert_ptr_eq (B.right, &A);
+ ck_assert_ptr_eq (B.left, &C);
+ ck_assert_ptr_eq (C.parent, &B);
+ ck_assert_ptr_eq (E.parent, &D);
+ ck_assert_ptr_eq (tree.root, &D);
+}
+END_TEST
+
+START_TEST (test_remove_9)
+{
+ enum { N = 4 };
+ const int values[N] = {10, 20, 30, 40};
+ struct itree_node *nodes[N] = {&N_10, &N_20, &N_30, &N_40};
+ interval_tree_init (&tree);
+ for (int i = 0; i < N; ++i)
+ itree_insert (&tree, nodes[i], values[i], values[i]);
+
+ ck_assert (tree.root == &N_20);
+ ck_assert (N_20.left == &N_10);
+ ck_assert (N_20.right == &N_30);
+ ck_assert (N_30.right == &N_40);
+ ck_assert (! N_20.red);
+ ck_assert (! N_10.red);
+ ck_assert (! N_30.red);
+ ck_assert (N_40.red);
+
+ itree_remove (&tree, &N_10);
+
+ ck_assert_ptr_eq (tree.root, &N_30);
+ ck_assert_ptr_null (N_30.parent);
+ ck_assert_ptr_eq (N_30.left, &N_20);
+ ck_assert_ptr_eq (N_30.right, &N_40);
+ ck_assert (! N_20.red);
+ ck_assert (! N_30.red);
+ ck_assert (! N_40.red);
+}
+END_TEST
+
+static void
+shuffle (int *index, int n)
+{
+ for (int i = n - 1; i >= 0; --i)
+ {
+ int j = random () % (i + 1);
+ int h = index[j];
+ index[j] = index[i];
+ index[i] = h;
+ }
+}
+
+START_TEST (test_remove_10)
+{
+ enum { N = 3 };
+ int index[N];
+ for (int i = 0; i < N; ++i)
+ index[i] = i;
+ srand (42);
+ shuffle (index, N);
+
+ interval_tree_init (&tree);
+ struct itree_node nodes[N];
+ for (int i = 0; i < N; ++i)
+ {
+ ptrdiff_t pos = (i + 1) * 10;
+ itree_insert (&tree, &nodes[index[i]], pos, pos + 1);
+ }
+
+ shuffle (index, N);
+ for (int i = 0; i < N; ++i)
+ {
+ ck_assert (interval_tree_contains (&tree, &nodes[index[i]]));
+ itree_remove (&tree, &nodes[index[i]]);
+ }
+ ck_assert_ptr_null (tree.root);
+ ck_assert_int_eq (tree.size, 0);
+}
+END_TEST
+
+
+/*
+===================================================================================+
+ * | Generator
+ *
+===================================================================================+
*/
+
+START_TEST (test_generator_1)
+{
+ struct itree_node node, *n;
+ struct itree_iterator *g;
+ interval_tree_init (&tree);
+
+ itree_insert (&tree, &node, 10, 20);
+ g = itree_iterator_start (&tree, 0, 30, ITREE_ASCENDING, NULL, 0);
+ n = itree_iterator_next (g);
+ ck_assert_ptr_eq (n, &node);
+ ck_assert_int_eq (n->begin, 10);
+ ck_assert_int_eq (n->end, 20);
+ ck_assert_ptr_null (itree_iterator_next (g));
+ ck_assert_ptr_null (itree_iterator_next (g));
+ ck_assert_ptr_null (itree_iterator_next (g));
+ itree_iterator_finish (g);
+
+ g = itree_iterator_start (&tree, 30, 50, ITREE_ASCENDING, NULL, 0);
+ ck_assert_ptr_null (itree_iterator_next (g));
+ ck_assert_ptr_null (itree_iterator_next (g));
+ ck_assert_ptr_null (itree_iterator_next (g));
+ itree_iterator_finish (g);
+}
+END_TEST
+
+static void
+test_check_generator (struct itree_tree *tree,
+ ptrdiff_t begin, ptrdiff_t end,
+ int n, ...)
+{
+ va_list ap;
+ struct itree_iterator *g =
+ itree_iterator_start (tree, begin, end, ITREE_ASCENDING, NULL, 0);
+
+ va_start (ap, n);
+ for (int i = 0; i < n; ++i)
+ {
+ struct itree_node *node = itree_iterator_next (g);
+ ck_assert_ptr_nonnull (node);
+ ck_assert_int_eq (node->begin, va_arg (ap, ptrdiff_t));
+ }
+ va_end (ap);
+ ck_assert_ptr_null (itree_iterator_next (g));
+ ck_assert_ptr_null (itree_iterator_next (g));
+ itree_iterator_finish (g);
+}
+
+START_TEST (test_generator_2)
+{
+ interval_tree_init (&tree);
+ struct itree_node nodes[3];
+ for (int i = 0; i < 3; ++i)
+ itree_insert (&tree, &nodes[i], 10 * (i + 1), 10 * (i + 2));
+
+ test_check_generator (&tree, 0, 50, 3,
+ 10, 20, 30);
+ test_check_generator (&tree, 0, 10, 0);
+ test_check_generator (&tree, 40, 50, 0);
+ test_check_generator (&tree, 15, 35, 3,
+ 10, 20, 30);
+ test_check_generator (&tree, -100, -50, 0);
+ test_check_generator (&tree, -100, -50, 0);
+ test_check_generator (&tree, 100, 50, 0);
+ test_check_generator (&tree, 100, 150, 0);
+ test_check_generator (&tree, 0, 0, 0);
+ test_check_generator (&tree, 40, 40, 0);
+ test_check_generator (&tree, 30, 30, 0);
+ test_check_generator (&tree, 35, 35, 1,
+ 30);
+}
+END_TEST
+
+static void
+test_create_tree (struct itree_node *nodes, int n, bool doshuffle)
+{
+ int *index = calloc (n, sizeof (int));
+ for (int i = 0; i < n; ++i)
+ index[i] = i;
+ if (doshuffle)
+ {
+ srand (42);
+ shuffle (index, n);
+ }
+
+ interval_tree_init (&tree);
+ for (int i = 0; i < n; ++i)
+ {
+ struct itree_node *node = &nodes[index[i]];
+ itree_insert (&tree, node, node->begin, node->end);
+ }
+ free (index);
+}
+
+START_TEST (test_generator_3)
+{
+ enum { N = 3 };
+ struct itree_node nodes[N] = {{.begin = 10, .end = 10},
+ {.begin = 10, .end = 10},
+ {.begin = 10, .end = 10}};
+ test_create_tree (nodes, N, true);
+ test_check_generator (&tree, 0, 10, 0);
+ test_check_generator (&tree, 10, 10, 3,
+ 10, 10, 10);
+ test_check_generator (&tree, 10, 20, 3,
+ 10, 10, 10);
+}
+END_TEST
+
+START_TEST (test_generator_5)
+{
+ enum { N = 4 };
+ struct itree_node nodes[N] = {{.begin = 10, .end = 30},
+ {.begin = 20, .end = 40},
+ {.begin = 30, .end = 50},
+ {.begin = 40, .end = 60}};
+ test_create_tree (nodes, N, false);
+ struct itree_iterator *g =
+ itree_iterator_start (&tree, 0, 100, ITREE_PRE_ORDER, NULL, 0);
+ for (int i = 0; i < N; ++i)
+ {
+ struct itree_node *n = itree_iterator_next (g);
+ ck_assert_ptr_nonnull (n);
+ switch (i)
+ {
+ case 0: ck_assert_int_eq (20, n->begin); break;
+ case 1: ck_assert_int_eq (10, n->begin); break;
+ case 2: ck_assert_int_eq (30, n->begin); break;
+ case 3: ck_assert_int_eq (40, n->begin); break;
+ }
+ }
+ itree_iterator_finish (g);
+}
+END_TEST
+
+START_TEST (test_generator_6)
+{
+ enum { N = 4 };
+ struct itree_node nodes[N] = {{.begin = 10, .end = 30},
+ {.begin = 20, .end = 40},
+ {.begin = 30, .end = 50},
+ {.begin = 40, .end = 60}};
+ test_create_tree (nodes, N, true);
+ struct itree_iterator *g =
+ itree_iterator_start (&tree, 0, 100, ITREE_ASCENDING, NULL, 0);
+ for (int i = 0; i < N; ++i)
+ {
+ struct itree_node *n = itree_iterator_next (g);
+ ck_assert_ptr_nonnull (n);
+ switch (i)
+ {
+ case 0: ck_assert_int_eq (10, n->begin); break;
+ case 1: ck_assert_int_eq (20, n->begin); break;
+ case 2: ck_assert_int_eq (30, n->begin); break;
+ case 3: ck_assert_int_eq (40, n->begin); break;
+ }
+ }
+ itree_iterator_finish (g);
+}
+END_TEST
+
+START_TEST (test_generator_7)
+{
+ enum { N = 4 };
+ struct itree_node nodes[N] = {{.begin = 10, .end = 30},
+ {.begin = 20, .end = 40},
+ {.begin = 30, .end = 50},
+ {.begin = 40, .end = 60}};
+ test_create_tree (nodes, N, true);
+ struct itree_iterator *g =
+ itree_iterator_start (&tree, 0, 100, ITREE_DESCENDING, NULL, 0);
+ for (int i = 0; i < N; ++i)
+ {
+ struct itree_node *n = itree_iterator_next (g);
+ ck_assert_ptr_nonnull (n);
+ switch (i)
+ {
+ case 0: ck_assert_int_eq (40, n->begin); break;
+ case 1: ck_assert_int_eq (30, n->begin); break;
+ case 2: ck_assert_int_eq (20, n->begin); break;
+ case 3: ck_assert_int_eq (10, n->begin); break;
+ }
+ }
+ itree_iterator_finish (g);
+}
+END_TEST
+
+START_TEST (test_generator_8)
+{
+ enum { N = 2 };
+ struct itree_node nodes[N] = {{.begin = 20, .end = 30},
+ {.begin = 40, .end = 50}};
+ test_create_tree (nodes, N, false);
+ struct itree_iterator *g =
+ itree_iterator_start (&tree, 1, 60, ITREE_DESCENDING, NULL, 0);
+ struct itree_node *n = itree_iterator_next (g);
+ ck_assert_int_eq (n->begin, 40);
+ itree_iterator_narrow (g, 50, 60);
+ n = itree_iterator_next (g);
+ ck_assert_ptr_null (n);
+ itree_iterator_finish (g);
+}
+END_TEST
+
+START_TEST (test_generator_9)
+{
+ enum { N = 2 };
+ struct itree_node nodes[N] = {{.begin = 25, .end = 25},
+ {.begin = 20, .end = 30}};
+ test_create_tree (nodes, N, false);
+ struct itree_iterator *g =
+ itree_iterator_start (&tree, 1, 30, ITREE_DESCENDING, NULL, 0);
+ struct itree_node *n = itree_iterator_next (g);
+ ck_assert_int_eq (n->begin, 25);
+ itree_iterator_narrow (g, 25, 30);
+ n = itree_iterator_next (g);
+ ck_assert_int_eq (n->begin, 20);
+ itree_iterator_finish (g);
+}
+END_TEST
+
+
+/*
+===================================================================================+
+ * | Insert Gap
+ *
+===================================================================================+
*/
+
+static struct itree_tree gap_tree;
+static struct itree_node gap_node;
+
+#define N_BEG (itree_node_begin (&gap_tree, &gap_node))
+#define N_END (itree_node_end (&gap_tree, &gap_node))
+
+static void
+test_setup_gap_node (ptrdiff_t begin, ptrdiff_t end,
+ bool front_advance, bool rear_advance)
+{
+ interval_tree_init (&gap_tree);
+ gap_node.front_advance = front_advance;
+ gap_node.rear_advance = rear_advance;
+ itree_insert (&gap_tree, &gap_node, begin, end);
+}
+
+static void
+test_setup_gap_node_noadvance (ptrdiff_t begin, ptrdiff_t end)
+{
+ test_setup_gap_node (begin, end, false, false);
+}
+
+START_TEST (test_gap_insert_1)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_insert_gap (&gap_tree, 100 + 10, 20, false);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200 + 20);
+}
+END_TEST
+
+START_TEST (test_gap_insert_2)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_insert_gap (&gap_tree, 300, 10, false);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200);
+}
+END_TEST
+
+START_TEST (test_gap_insert_3)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_insert_gap (&gap_tree, 0, 15, false);
+ ck_assert_int_eq (N_BEG, 100 + 15);
+ ck_assert_int_eq (N_END, 200 + 15);
+}
+END_TEST
+
+START_TEST (test_gap_insert_4)
+{
+ test_setup_gap_node (100, 200, true, false);
+ itree_insert_gap (&gap_tree, 100, 20, false);
+ ck_assert_int_eq (N_BEG, 100 + 20);
+ ck_assert_int_eq (N_END, 200 + 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_5)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_insert_gap (&gap_tree, 100, 20, false);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200 + 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_6)
+{
+ test_setup_gap_node (100, 200, false, true);
+ itree_insert_gap (&gap_tree, 200, 20, false);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200 + 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_7)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_insert_gap (&gap_tree, 200, 20, false);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_8)
+{
+ test_setup_gap_node (100, 100, true, true);
+ itree_insert_gap (&gap_tree, 100, 20, false);
+ ck_assert_int_eq (N_BEG, 100 + 20);
+ ck_assert_int_eq (N_END, 100 + 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_9)
+{
+ test_setup_gap_node (100, 100, false, true);
+ itree_insert_gap (&gap_tree, 100, 20, false);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 100 + 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_10)
+{
+ test_setup_gap_node (100, 100, true, false);
+ itree_insert_gap (&gap_tree, 100, 20, false);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 100);
+
+}
+END_TEST
+
+START_TEST (test_gap_insert_11)
+{
+ test_setup_gap_node_noadvance (100, 100);
+ itree_insert_gap (&gap_tree, 100, 20, false);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 100);
+
+}
+END_TEST
+
+
+/*
+===================================================================================+
+ * | Delete Gap
+ *
+===================================================================================+
*/
+
+START_TEST (test_gap_delete_1)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_delete_gap (&gap_tree, 100 + 10, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200 - 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_delete_2)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_delete_gap (&gap_tree, 200 + 10, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200);
+
+}
+END_TEST
+
+START_TEST (test_gap_delete_3)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_delete_gap (&gap_tree, 200, 20);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 200);
+
+}
+END_TEST
+
+START_TEST (test_gap_delete_4)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_delete_gap (&gap_tree, 100 - 20, 20);
+ ck_assert_int_eq (N_BEG, 100 - 20);
+ ck_assert_int_eq (N_END, 200 - 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_delete_5)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_delete_gap (&gap_tree, 70, 20);
+ ck_assert_int_eq (N_BEG, 100 - 20);
+ ck_assert_int_eq (N_END, 200 - 20);
+
+}
+END_TEST
+
+START_TEST (test_gap_delete_6)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_delete_gap (&gap_tree, 80, 100);
+ ck_assert_int_eq (N_BEG, 80);
+ ck_assert_int_eq (N_END, 100);
+}
+END_TEST
+
+START_TEST (test_gap_delete_7)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_delete_gap (&gap_tree, 120, 100);
+ ck_assert_int_eq (N_BEG, 100);
+ ck_assert_int_eq (N_END, 120);
+}
+END_TEST
+
+START_TEST (test_gap_delete_8)
+{
+ test_setup_gap_node_noadvance (100, 200);
+ itree_delete_gap (&gap_tree, 100 - 20, 200 + 20);
+ ck_assert_int_eq (N_BEG, 100 - 20);
+ ck_assert_int_eq (N_END, 100 - 20);
+
+}
+END_TEST
+
+
+
+static Suite *
+basic_suite ()
+{
+ Suite *s = suite_create ("basic");
+
+ TCase *tc = tcase_create ("insert1");
+ tcase_add_checked_fixture (tc, test_insert1_setup, NULL);
+ tcase_add_test (tc, test_insert_1);
+ tcase_add_test (tc, test_insert_2);
+ tcase_add_test (tc, test_insert_3);
+ tcase_add_test (tc, test_insert_4);
+ tcase_add_test (tc, test_insert_5);
+ tcase_add_test (tc, test_insert_6);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("insert2");
+ tcase_add_checked_fixture (tc, test_insert2_setup, NULL);
+ tcase_add_test (tc, test_insert_7);
+ tcase_add_test (tc, test_insert_8);
+ tcase_add_test (tc, test_insert_9);
+ tcase_add_test (tc, test_insert_10);
+ tcase_add_test (tc, test_insert_11);
+ tcase_add_test (tc, test_insert_12);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("insert3");
+ tcase_add_test (tc, test_insert_13);
+ tcase_add_test (tc, test_insert_14);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("remove1");
+ tcase_add_checked_fixture (tc, test_remove1_setup, NULL);
+ tcase_add_test (tc, test_remove_1);
+ tcase_add_test (tc, test_remove_2);
+ tcase_add_test (tc, test_remove_3);
+ tcase_add_test (tc, test_remove_4);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("remove2");
+ tcase_add_checked_fixture (tc, test_remove2_setup, NULL);
+ tcase_add_test (tc, test_remove_5);
+ tcase_add_test (tc, test_remove_6);
+ tcase_add_test (tc, test_remove_7);
+ tcase_add_test (tc, test_remove_8);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("remove3");
+ tcase_add_test (tc, test_remove_9);
+ tcase_add_test (tc, test_remove_10);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("generator");
+ tcase_add_test (tc, test_generator_1);
+ tcase_add_test (tc, test_generator_2);
+ tcase_add_test (tc, test_generator_3);
+ tcase_add_test (tc, test_generator_5);
+ tcase_add_test (tc, test_generator_6);
+ tcase_add_test (tc, test_generator_7);
+ tcase_add_test (tc, test_generator_8);
+ tcase_add_test (tc, test_generator_9);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("insert_gap");
+ tcase_add_test (tc, test_gap_insert_1);
+ tcase_add_test (tc, test_gap_insert_2);
+ tcase_add_test (tc, test_gap_insert_3);
+ tcase_add_test (tc, test_gap_insert_4);
+ tcase_add_test (tc, test_gap_insert_5);
+ tcase_add_test (tc, test_gap_insert_6);
+ tcase_add_test (tc, test_gap_insert_7);
+ tcase_add_test (tc, test_gap_insert_8);
+ tcase_add_test (tc, test_gap_insert_9);
+ tcase_add_test (tc, test_gap_insert_10);
+ tcase_add_test (tc, test_gap_insert_11);
+ suite_add_tcase (s, tc);
+
+ tc = tcase_create ("delete_gap");
+ tcase_add_test (tc, test_gap_delete_1);
+ tcase_add_test (tc, test_gap_delete_2);
+ tcase_add_test (tc, test_gap_delete_3);
+ tcase_add_test (tc, test_gap_delete_4);
+ tcase_add_test (tc, test_gap_delete_5);
+ tcase_add_test (tc, test_gap_delete_6);
+ tcase_add_test (tc, test_gap_delete_7);
+ tcase_add_test (tc, test_gap_delete_8);
+ suite_add_tcase (s, tc);
+
+ return s;
+}
+
+int
+main (void)
+{
+ Suite *s = basic_suite ();
+ SRunner *sr = srunner_create (s);
+
+ init_itree ();
+ srunner_run_all (sr, CK_ENV);
+ int nfailed = srunner_ntests_failed (sr);
+ srunner_free (sr);
+ return (nfailed == 0) ? EXIT_SUCCESS : EXIT_FAILURE;
+}
diff --git a/test/manual/noverlay/many-errors.py
b/test/manual/noverlay/many-errors.py
new file mode 100644
index 0000000000..fa4ef5f98d
--- /dev/null
+++ b/test/manual/noverlay/many-errors.py
@@ -0,0 +1,2480 @@
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
+def a(x, y, y):
+ return t; pass
diff --git a/test/manual/noverlay/overlay-perf.el
b/test/manual/noverlay/overlay-perf.el
new file mode 100644
index 0000000000..4d79254a53
--- /dev/null
+++ b/test/manual/noverlay/overlay-perf.el
@@ -0,0 +1,764 @@
+;; -*- lexical-binding:t -*-
+(require 'cl-lib)
+(require 'subr-x)
+(require 'seq)
+(require 'hi-lock)
+
+
+;;
+===================================================================================+
+;; | Framework
+;;
+===================================================================================+
+
+(defmacro perf-define-constant-test (name &optional doc &rest body)
+ (declare (indent 1) (debug (symbol &optional string &rest form)))
+ `(progn
+ (put ',name 'perf-constant-test t)
+ (defun ,name nil ,doc ,@body)))
+
+(defmacro perf-define-variable-test (name args &optional doc &rest body)
+ (declare (indent 2) (debug defun))
+ (unless (and (consp args)
+ (= (length args) 1))
+ (error "Function %s should accept exactly one argument." name))
+ `(progn
+ (put ',name 'perf-variable-test t)
+ (defun ,name ,args ,doc ,@body)))
+
+(defmacro perf-define-test-suite (name &rest tests)
+ (declare (indent 1))
+ `(put ',name 'perf-test-suite
+ ,(cons 'list tests)))
+
+(defun perf-constant-test-p (test)
+ (get test 'perf-constant-test))
+
+(defun perf-variable-test-p (test)
+ (get test 'perf-variable-test))
+
+(defun perf-test-suite-p (suite)
+ (not (null (perf-test-suite-elements suite))))
+
+(defun perf-test-suite-elements (suite)
+ (get suite 'perf-test-suite))
+
+(defun perf-expand-suites (test-and-suites)
+ (apply #' append (mapcar (lambda (elt)
+ (if (perf-test-suite-p elt)
+ (perf-test-suite-elements elt)
+ (list elt)))
+ test-and-suites)))
+(defun perf-test-p (symbol)
+ (or (perf-variable-test-p symbol)
+ (perf-constant-test-p symbol)))
+
+(defun perf-all-tests ()
+ (let (result)
+ (mapatoms (lambda (symbol)
+ (when (and (fboundp symbol)
+ (perf-test-p symbol))
+ (push symbol result))))
+ (sort result #'string-lessp)))
+
+(defvar perf-default-test-argument 4096)
+
+(defun perf-run-1 (&optional k n &rest tests)
+ "Run TESTS K times using N as argument for non-constant ones.
+
+Return test-total elapsed time."
+ (random "")
+ (when (and n (not (numberp n)))
+ (push k tests)
+ (push n tests)
+ (setq n nil k nil))
+ (when (and k (not (numberp k)))
+ (push k tests)
+ (setq k nil))
+ (let* ((k (or k 1))
+ (n (or n perf-default-test-argument))
+ (tests (perf-expand-suites (or tests
+ (perf-all-tests))))
+ (variable-tests (seq-filter #'perf-variable-test-p tests))
+ (constant-tests (seq-filter #'perf-constant-test-p tests))
+ (max-test-string-width (perf-max-symbol-length tests)))
+ (unless (seq-every-p #'perf-test-p tests)
+ (error "Some of these are not tests: %s" tests))
+ (cl-labels ((format-result (result)
+ (cond
+ ((numberp result) (format "%.2f" result))
+ ((stringp result) result)
+ ((null result) "N/A")))
+ (format-test (fn)
+ (concat (symbol-name fn)
+ (make-string
+ (+ (- max-test-string-width
+ (length (symbol-name fn)))
+ 1)
+ ?\s)))
+ (format-summary (results _total)
+ (let ((min (apply #'min results))
+ (max (apply #'max results))
+ (avg (/ (apply #'+ results) (float (length results)))))
+ (format "n=%d min=%.2f avg=%.2f max=%.2f" (length results)
min avg max)))
+ (run-test (fn)
+ (let ((total 0) results)
+ (dotimes (_ (max 0 k))
+ (garbage-collect)
+ (princ (concat " " (format-test fn)))
+ (let ((result (condition-case-unless-debug err
+ (cond
+ ((perf-variable-test-p fn)
+ (random "") (car (funcall fn n)))
+ ((perf-constant-test-p fn)
+ (random "") (car (funcall fn)))
+ (t "skip"))
+ (error (error-message-string err)))))
+ (when (numberp result)
+ (cl-incf total result)
+ (push result results))
+ (princ (format-result result))
+ (terpri)))
+ (when (> (length results) 1)
+ (princ (concat "#" (format-test fn)
+ (format-summary results total)))
+ (terpri)))))
+ (when variable-tests
+ (terpri)
+ (dolist (fn variable-tests)
+ (run-test fn)
+ (terpri)))
+ (when constant-tests
+ (dolist (fn constant-tests)
+ (run-test fn)
+ (terpri))))))
+
+(defun perf-run (&optional k n &rest tests)
+ (interactive
+ (let* ((n (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ perf-default-test-argument))
+ (tests (mapcar #'intern
+ (completing-read-multiple
+ (format "Run tests (n=%d): " n)
+ (perf-all-tests) nil t nil 'perf-test-history))))
+ (cons 1 (cons n tests))))
+ (with-current-buffer (get-buffer-create "*perf-results*")
+ (let ((inhibit-read-only t)
+ (standard-output (current-buffer)))
+ (erase-buffer)
+ (apply #'perf-run-1 k n tests)
+ (display-buffer (current-buffer)))))
+
+
+(defun perf-batch-parse-command-line (args)
+ (let ((k 1)
+ (n perf-default-test-argument)
+ tests)
+ (while args
+ (cond ((string-match-p "\\`-[cn]\\'" (car args))
+ (unless (and (cdr args)
+ (string-match-p "\\`[0-9]+\\'" (cadr args)))
+ (error "%s expects a natnum argument" (car args)))
+ (if (equal (car args) "-c")
+ (setq k (string-to-number (cadr args)))
+ (setq n (string-to-number (cadr args))))
+ (setq args (cddr args)))
+ (t (push (intern (pop args)) tests))))
+ (list k n tests)))
+
+
+(defun perf-run-batch ()
+ "Runs tests from `command-line-args-left' and kill emacs."
+ (let ((standard-output #'external-debugging-output))
+ (condition-case err
+ (cl-destructuring-bind (k n tests)
+ (perf-batch-parse-command-line command-line-args-left)
+ (apply #'perf-run-1 k n tests)
+ (save-buffers-kill-emacs))
+ (error
+ (princ (error-message-string err))
+ (save-buffers-kill-emacs)))))
+
+(defconst perf-number-of-columns 70)
+
+(defun perf-insert-lines (n)
+ "Insert N lines into the current buffer."
+ (dotimes (i n)
+ (insert (make-string 70 (if (= (% i 2) 0)
+ ?.
+ ?O))
+ ?\n)))
+
+(defun perf-switch-to-buffer-scroll-random (n &optional buffer)
+ (interactive)
+ (set-window-buffer nil (or buffer (current-buffer)))
+ (goto-char (point-min))
+ (redisplay t)
+ (dotimes (_ n)
+ (goto-char (random (point-max)))
+ (recenter)
+ (redisplay t)))
+
+(defun perf-insert-overlays (n &optional create-callback random-p)
+ (if random-p
+ (perf-insert-overlays-random n create-callback)
+ (perf-insert-overlays-sequential n create-callback)))
+
+(defun perf-insert-overlays-sequential (n &optional create-callback)
+ "Insert an overlay every Nth line."
+ (declare (indent 1))
+ (let ((i 0)
+ (create-callback (or create-callback #'ignore)))
+ (save-excursion
+ (goto-char (point-min))
+ (while (not (eobp))
+ (when (= 0 (% i n))
+ (let ((ov (make-overlay (point-at-bol) (point-at-eol))))
+ (funcall create-callback ov)
+ (overlay-put ov 'priority (random (buffer-size)))))
+ (cl-incf i)
+ (forward-line)))))
+
+(defun perf-insert-overlays-random (n &optional create-callback)
+ "Insert an overlay every Nth line."
+ (declare (indent 1))
+ (let ((create-callback (or create-callback #'ignore)))
+ (save-excursion
+ (while (>= (cl-decf n) 0)
+ (let* ((beg (1+ (random (point-max))))
+ (ov (make-overlay beg (+ beg (random 70)))))
+ (funcall create-callback ov)
+ (overlay-put ov 'priority (random (buffer-size))))))))
+
+(defun perf-insert-overlays-hierarchical (n &optional create-callback)
+ (let ((create-callback (or create-callback #'ignore)))
+ (save-excursion
+ (goto-char (point-min))
+ (let ((spacing (floor (/ (/ (count-lines (point-min) (point-max))
+ (float 3))
+ n))))
+ (when (< spacing 1)
+ (error "Hierarchical overlay overflow !!"))
+ (dotimes (i n)
+ (funcall create-callback
+ (make-overlay (point)
+ (save-excursion
+ (goto-char (point-max))
+ (forward-line (- (* spacing i)))
+ (point))))
+
+ (when (eobp)
+ (error "End of buffer in hierarchical overlays"))
+ (forward-line spacing))))))
+
+(defun perf-overlay-ascii-chart (&optional buffer width)
+ (interactive)
+ (save-current-buffer
+ (when buffer (set-buffer buffer))
+ (unless width (setq width 100))
+ (let* ((ovl (sort (overlays-in (point-min) (point-max))
+ (lambda (ov1 ov2)
+ (or (<= (overlay-start ov1)
+ (overlay-start ov2))
+ (and
+ (= (overlay-start ov1)
+ (overlay-start ov2))
+ (< (overlay-end ov1)
+ (overlay-end ov2)))))))
+ (ov-width (apply #'max (mapcar (lambda (ov)
+ (- (overlay-end ov)
+ (overlay-start ov)))
+ ovl)))
+ (ov-min (apply #'min (mapcar #'overlay-start ovl)))
+ (ov-max (apply #'max (mapcar #'overlay-end ovl)))
+ (scale (/ (float width) (+ ov-min ov-width))))
+ (with-current-buffer (get-buffer-create "*overlay-ascii-chart*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (buffer-disable-undo)
+ (insert (format "%06d%s%06d\n" ov-min (make-string (- width 12) ?\s)
ov-max))
+ (dolist (ov ovl)
+ (let ((length (round (* scale (- (overlay-end ov)
+ (overlay-start ov))))))
+ (insert (make-string (round (* scale (overlay-start ov))) ?\s))
+ (cl-case length
+ (0 (insert "O"))
+ (1 (insert "|"))
+ (t (insert (format "|%s|" (make-string (- length 2) ?-)))))
+ (insert "\n")))
+ (goto-char (point-min)))
+ (read-only-mode 1)
+ (pop-to-buffer (current-buffer))))))
+
+(defconst perf-overlay-faces (mapcar #'intern (seq-take hi-lock-face-defaults
3)))
+
+(defun perf-overlay-face-callback (ov)
+ (overlay-put ov 'face (nth (random (length perf-overlay-faces))
+ perf-overlay-faces)))
+
+(defun perf-overlay-invisible-callback (ov)
+ (overlay-put ov 'invisble (= 1 (random 2))))
+
+(defun perf-overlay-display-callback (ov)
+ (overlay-put ov 'display (make-string 70 ?*)))
+
+(defmacro perf-define-display-test (overlay-type property-type scroll-type)
+ (let ((name (intern (format "perf-display-%s/%s/%s"
+ overlay-type property-type scroll-type)))
+ (arg (make-symbol "n")))
+
+ `(perf-define-variable-test ,name (,arg)
+ (with-temp-buffer
+ (perf-insert-lines ,arg)
+ (overlay-recenter (point-max))
+ ,@(perf-define-display-test-1 arg overlay-type property-type
scroll-type)))))
+
+(defun perf-define-display-test-1 (arg overlay-type property-type scroll-type)
+ (list (append (cl-case overlay-type
+ (sequential
+ (list 'perf-insert-overlays-sequential 2))
+ (hierarchical
+ `(perf-insert-overlays-hierarchical (/ ,arg 10)))
+ (random
+ `(perf-insert-overlays-random (/ ,arg 2)))
+ (t (error "Invalid insert type: %s" overlay-type)))
+ (list
+ (cl-case property-type
+ (display '#'perf-overlay-display-callback)
+ (face '#'perf-overlay-face-callback)
+ (invisible '#'perf-overlay-invisible-callback)
+ (t (error "Invalid overlay type: %s" overlay-type)))))
+ (list 'benchmark-run 1
+ (cl-case scroll-type
+ (scroll '(perf-switch-to-buffer-scroll-up-and-down))
+ (random `(perf-switch-to-buffer-scroll-random (/ ,arg 50)))
+ (t (error "Invalid scroll type: %s" overlay-type))))))
+
+(defun perf-max-symbol-length (symbols)
+ "Return the longest symbol in SYMBOLS, or -1 if symbols is nil."
+ (if (null symbols)
+ -1
+ (apply #'max (mapcar
+ (lambda (elt)
+ (length (symbol-name elt)))
+ symbols))))
+
+(defun perf-insert-text (n)
+ "Insert N character into the current buffer."
+ (let ((ncols 68)
+ (char ?.))
+ (dotimes (_ (/ n ncols))
+ (insert (make-string (1- ncols) char) ?\n))
+ (when (> (% n ncols) 0)
+ (insert (make-string (1- (% n ncols)) char) ?\n))))
+
+(defconst perf-insert-overlays-default-length 24)
+
+(defun perf-insert-overlays-scattered (n &optional length)
+ "Insert N overlays of max length 24 randomly."
+ (dotimes (_ n)
+ (let ((begin (random (1+ (point-max)))))
+ (make-overlay
+ begin (+ begin (random (1+ (or length
perf-insert-overlays-default-length 0))))))))
+
+(defvar perf-marker-gc-protection nil)
+
+(defun perf-insert-marker-scattered (n)
+ "Insert N marker randomly."
+ (setq perf-marker-gc-protection nil)
+ (dotimes (_ n)
+ (push (copy-marker (random (1+ (point-max))))
+ perf-marker-gc-protection)))
+
+(defun perf-switch-to-buffer-scroll-up-and-down (&optional buffer)
+ (interactive)
+ (set-window-buffer nil (or buffer (current-buffer)))
+ (goto-char (point-min))
+ (redisplay t)
+ (while (condition-case nil
+ (progn (scroll-up) t)
+ (end-of-buffer nil))
+ (redisplay t))
+ (while (condition-case nil
+ (progn (scroll-down) t)
+ (beginning-of-buffer nil))
+ (redisplay t)))
+
+(defun perf-emacs-lisp-setup ()
+ (add-to-list 'imenu-generic-expression
+ '(nil
"^\\s-*(perf-define\\(?:\\w\\|\\s_\\)*\\s-*\\(\\(?:\\w\\|\\s_\\)+\\)" 1)))
+
+(add-hook 'emacs-lisp-mode 'perf-emacs-lisp-setup)
+
+
+;;
+===================================================================================+
+;; | Basic performance tests
+;;
+===================================================================================+
+
+(perf-define-variable-test perf-make-overlay (n)
+ (with-temp-buffer
+ (overlay-recenter (point-min))
+ (benchmark-run 1
+ (dotimes (_ n)
+ (make-overlay 1 1)))))
+
+(perf-define-variable-test perf-make-overlay-continuous (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (overlay-recenter (point-max))
+ (benchmark-run 1
+ (dotimes (i n)
+ (make-overlay i (1+ i))))))
+
+(perf-define-variable-test perf-make-overlay-scatter (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (benchmark-run 1
+ (perf-insert-overlays-scattered n))))
+
+(perf-define-variable-test perf-delete-overlay (n)
+ (with-temp-buffer
+ (let ((ovls (cl-loop for i from 1 to n
+ collect (make-overlay 1 1))))
+ (overlay-recenter (point-min))
+ (benchmark-run 1
+ (mapc #'delete-overlay ovls)))))
+
+(perf-define-variable-test perf-delete-overlay-continuous (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (let ((ovls (cl-loop for i from 1 to n
+ collect (make-overlay i (1+ i)))))
+ (overlay-recenter (point-min))
+ (benchmark-run 1
+ (mapc #'delete-overlay ovls)))))
+
+(perf-define-variable-test perf-delete-overlay-scatter (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (let ((ovls (progn (perf-insert-overlays-scattered n)
+ (overlays-in (point-min) (point-max)))))
+ (benchmark-run 1
+ (mapc #'delete-overlay ovls)))))
+
+(perf-define-variable-test perf-overlays-at (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (benchmark-run 1
+ (dotimes (i (point-max))
+ (overlays-at i)))))
+
+(perf-define-variable-test perf-overlays-in (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (let ((len perf-insert-overlays-default-length))
+ (benchmark-run 1
+ (dotimes (i (- (point-max) len))
+ (overlays-in i (+ i len)))))))
+
+(perf-define-variable-test perf-insert-before (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char 1)
+ (overlay-recenter (point-min))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (insert ?X)))))
+
+(perf-define-variable-test perf-insert-before-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-insert-before n)))
+(perf-define-variable-test perf-insert-after-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-insert-after n)))
+(perf-define-variable-test perf-insert-scatter-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-insert-scatter n)))
+(perf-define-variable-test perf-delete-before-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-delete-before n)))
+(perf-define-variable-test perf-delete-after-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-delete-after n)))
+(perf-define-variable-test perf-delete-scatter-empty (n)
+ (let ((perf-insert-overlays-default-length 0))
+ (perf-delete-scatter n)))
+
+(defmacro perf-define-marker-test (type where)
+ (let ((name (intern (format "perf-%s-%s-marker" type where))))
+ `(perf-define-variable-test ,name (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-marker-scattered n)
+ (goto-char ,(cl-case where
+ (after (list 'point-max))
+ (t (list 'point-min))))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ ,@(when (eq where 'scatter)
+ (list '(goto-char (max 1 (random (point-max))))))
+ ,(cl-case type
+ (insert (list 'insert ?X))
+ (delete (list 'delete-char (if (eq where 'after) -1 1))))))))))
+
+(perf-define-test-suite perf-marker-suite
+ (perf-define-marker-test insert before)
+ (perf-define-marker-test insert after)
+ (perf-define-marker-test insert scatter)
+ (perf-define-marker-test delete before)
+ (perf-define-marker-test delete after)
+ (perf-define-marker-test delete scatter))
+
+(perf-define-variable-test perf-insert-after (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char (point-max))
+ (overlay-recenter (point-max))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (insert ?X)))))
+
+(perf-define-variable-test perf-insert-scatter (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char (point-max))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (goto-char (1+ (random (point-max))))
+ (insert ?X)))))
+
+(perf-define-variable-test perf-delete-before (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char 1)
+ (overlay-recenter (point-min))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (delete-char 1)))))
+
+(perf-define-variable-test perf-delete-after (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char (point-max))
+ (overlay-recenter (point-max))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (delete-char -1)))))
+
+(perf-define-variable-test perf-delete-scatter (n)
+ (with-temp-buffer
+ (perf-insert-text n)
+ (perf-insert-overlays-scattered n)
+ (goto-char (point-max))
+ (benchmark-run 1
+ (dotimes (_ (/ n 2))
+ (goto-char (max 1 (random (point-max))))
+ (delete-char 1)))))
+
+(perf-define-test-suite perf-insert-delete-suite
+ 'perf-insert-before
+ 'perf-insert-after
+ 'perf-insert-scatter
+ 'perf-delete-before
+ 'perf-delete-after
+ 'perf-delete-scatter
+ )
+
+
+;;
+===================================================================================+
+;; | Redisplay (new)
+;;
+===================================================================================+
+
+;; 5000
+;; 25000
+;; 75000
+
+;; Number of Overlays = N / 2
+;;
+;; (except for the hierarchical case, where it is divided by 10.)
+
+ ;; . scrolling through a buffer with lots of overlays that affect faces
+ ;; of characters in the buffer text
+ ;; . scrolling through a buffer with lots of overlays that define
+ ;; 'display' properties which are strings
+ ;; . scrolling through a buffer with lots of overlays that define
+ ;; 'invisible' properties
+
+(perf-define-test-suite perf-display-suite
+ (perf-define-display-test sequential display scroll)
+ (perf-define-display-test sequential display random)
+ (perf-define-display-test sequential face scroll)
+ (perf-define-display-test sequential face random)
+ (perf-define-display-test sequential invisible scroll)
+ (perf-define-display-test sequential invisible random)
+ (perf-define-display-test random display scroll)
+ (perf-define-display-test random display random)
+ (perf-define-display-test random face scroll)
+ (perf-define-display-test random face random)
+ (perf-define-display-test random invisible scroll)
+ (perf-define-display-test random invisible random))
+
+;; |------------|
+;; |--------|
+;; |----|
+(perf-define-display-test hierarchical face scroll)
+
+
+
+
+;;
+===================================================================================+
+;; | Real World
+;;
+===================================================================================+
+
+(require 'python)
+
+(defconst perf-many-errors-file
+ (expand-file-name "many-errors.py"
+ (and load-file-name (file-name-directory load-file-name))))
+
+(perf-define-constant-test perf-realworld-flycheck
+ (interactive)
+ (package-initialize)
+ (when (and (require 'flycheck nil t)
+ (file-exists-p perf-many-errors-file)
+ (or (executable-find "pylint")
+ (executable-find "flake8")))
+ (setq flycheck-python-pylint-executable
+ (executable-find "pylint"))
+ (setq flycheck-python-flake8-executable
+ (executable-find "flake8"))
+ (setq python-indent-guess-indent-offset-verbose nil)
+ (setq flycheck-check-syntax-automatically nil)
+ (setq flycheck-checker-error-threshold nil)
+ (setq flycheck-display-errors-function nil)
+ (with-current-buffer (find-file-noselect perf-many-errors-file)
+ (let* ((done)
+ (flycheck-after-syntax-check-hook
+ (list (lambda () (setq done t)))))
+ (flycheck-mode 1)
+ (flycheck-buffer)
+ (benchmark-run 1
+ (while (not done)
+ (accept-process-output))
+ (perf-switch-to-buffer-scroll-up-and-down)
+ (flycheck-mode -1))))))
+
+;; https://lists.gnu.org/archive/html/emacs-devel/2009-04/msg00242.html
+(defun make-lines-invisible (regexp &optional arg)
+ "Make all lines matching a regexp invisible and intangible.
+With a prefix arg, make it visible again. It is not necessary
+that REGEXP matches the whole line; if a hit is found, the
+affected line gets automatically selected.
+
+This command affects the whole buffer."
+ (interactive "MRegexp: \nP")
+ (let (ov
+ ovs
+ count)
+ (cond
+ ((equal arg '(4))
+ (setq ovs (overlays-in (point-min) (point-max)))
+ (mapc (lambda (o)
+ (if (overlay-get o 'make-lines-invisible)
+ (delete-overlay o)))
+ ovs))
+ (t
+ (save-excursion
+ (goto-char (point-min))
+ (setq count 0)
+ (while (re-search-forward regexp nil t)
+ (setq count (1+ count))
+ (if (= (% count 100) 0)
+ (message "%d" count))
+ (setq ov (make-overlay (line-beginning-position)
+ (1+ (line-end-position))))
+ (overlay-put ov 'make-lines-invisible t)
+ (overlay-put ov 'invisible t)
+ (overlay-put ov 'intangible t)
+ (goto-char (line-end-position))))))))
+
+(perf-define-constant-test perf-realworld-make-lines-invisible
+ (with-temp-buffer
+ (insert-file-contents "/usr/share/dict/words")
+ (set-window-buffer nil (current-buffer))
+ (redisplay t)
+ (overlay-recenter (point-max))
+ (benchmark-run 1
+ (make-lines-invisible "a"))))
+
+(perf-define-constant-test perf-realworld-line-numbering
+ (interactive)
+ (with-temp-buffer
+ (insert-file-contents "/usr/share/dict/words")
+ (overlay-recenter (point-max))
+ (goto-char (point-min))
+ (let* ((nlines (count-lines (point-min) (point-max)))
+ (line 1)
+ (width 0))
+ (dotimes (i nlines) ;;-with-progress-reporter "Creating overlays"
+ (let ((ov (make-overlay (point) (point)))
+ (str (propertize (format "%04d" line) 'face 'shadow)))
+ (overlay-put ov 'before-string
+ (propertize " " 'display `((margin left-margin) ,str)))
+ (setq width (max width (length str)))
+ (cl-incf line)
+ (forward-line)))
+ (benchmark-run 1
+ (let ((left-margin-width width))
+ (perf-switch-to-buffer-scroll-up-and-down))))))
+
+(perf-define-test-suite perf-realworld-suite
+ 'perf-realworld-flycheck
+ 'perf-realworld-make-lines-invisible
+ 'perf-realworld-line-numbering)
+
+
+;;
+===================================================================================+
+;; | next-overlay-change
+;;
+===================================================================================+
+
+(perf-define-variable-test perf-noc-hierarchical/forward/linear (n)
+ "Search linear for the next change on every line."
+ (with-temp-buffer
+ (perf-insert-lines (* 3 n))
+ (perf-insert-overlays-hierarchical n)
+ (goto-char (point-min))
+ (benchmark-run 1
+ (while (not (eobp))
+ (next-overlay-change (point))
+ (forward-line)))))
+
+(perf-define-variable-test perf-noc-sequential/forward/linear (n)
+ "Search linear for the next change on every line."
+ (with-temp-buffer
+ (perf-insert-lines (* 3 n))
+ (perf-insert-overlays-sequential n)
+ (goto-char (point-min))
+ (benchmark-run 1
+ (while (not (eobp))
+ (next-overlay-change (point))
+ (forward-line)))))
+
+(perf-define-variable-test perf-noc-hierarchical/forward/backnforth (n)
+ "Search back and forth for the next change from `point-min' to `point-max'."
+ (with-temp-buffer
+ (perf-insert-lines (* 3 n))
+ (overlay-recenter (point-max))
+ (perf-insert-overlays-hierarchical n)
+ (goto-char (point-min))
+ (benchmark-run 1
+ (while (not (eobp))
+ (next-overlay-change (point))
+ (next-overlay-change (+ (point) 2))
+ (forward-char)))))
+
+(perf-define-test-suite perf-noc-suite
+ 'perf-noc-hierarchical/forward/linear
+ 'perf-noc-hierarchical/forward/backnforth
+ 'perf-noc-hierarchical/forward/backnforth)
diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el
index 558d05de14..0e6d717cbb 100644
--- a/test/src/buffer-tests.el
+++ b/test/src/buffer-tests.el
@@ -20,6 +20,7 @@
;;; Code:
(require 'ert)
+(require 'seq)
(require 'ert-x)
(require 'cl-lib)
(require 'let-alist)
@@ -41,7 +42,6 @@ recorded calls conveniently."
overlay
hooks-property
(list (lambda (ov &rest args)
- (message " %S called on %S with args %S" hooks-property ov args)
(should inhibit-modification-hooks)
(should (eq ov overlay))
(push (list hooks-property args)
@@ -174,47 +174,41 @@ properties."
(t 1 2 0))
(insert-behind-hooks
(t 1 2 0)))))))
- (message "BEGIN overlay-modification-hooks test-case %S" test-case)
-
- ;; All three hooks ignore the overlay's `front-advance' and
- ;; `rear-advance' option, so test both ways while expecting the same
- ;; result.
- (dolist (advance '(nil t))
- (message " advance is %S" advance)
- (let-alist test-case
- (with-temp-buffer
- ;; Set up the temporary buffer and overlay as specified by
- ;; the test case.
- (insert (or .buffer-text "1234"))
- (let ((overlay (make-overlay
- (or .overlay-beg 2)
- (or .overlay-end 4)
- nil
- advance advance)))
- (message " (buffer-string) is %S" (buffer-string))
- (message " overlay is %S" overlay)
- (overlay-tests-start-recording-modification-hooks overlay)
-
- ;; Modify the buffer, possibly inducing calls to the
- ;; overlay's modification hooks.
- (should (or .insert-at .replace))
- (when .insert-at
- (goto-char .insert-at)
- (insert "x")
- (message " inserted \"x\" at %S, buffer-string now %S"
- .insert-at (buffer-string)))
- (when .replace
- (goto-char (point-min))
- (search-forward .replace)
- (replace-match "x")
- (message " replaced %S with \"x\"" .replace))
-
- ;; Verify that the expected and actual modification hook
- ;; calls match.
- (should (equal
- .expected-calls
- (overlay-tests-get-recorded-modification-hooks
- overlay)))))))))
+ (ert-info ((format "test-case: %S" test-case))
+ ;; All three hooks ignore the overlay's `front-advance' and
+ ;; `rear-advance' option, so test both ways while expecting the same
+ ;; result.
+ (dolist (advance '(nil t))
+ (ert-info ((format "advance is %S" advance))
+ (let-alist test-case
+ (with-temp-buffer
+ ;; Set up the temporary buffer and overlay as specified by
+ ;; the test case.
+ (insert (or .buffer-text "1234"))
+ (let ((overlay (make-overlay
+ (or .overlay-beg 2)
+ (or .overlay-end 4)
+ nil
+ advance advance)))
+ (overlay-tests-start-recording-modification-hooks overlay)
+
+ ;; Modify the buffer, possibly inducing calls to the
+ ;; overlay's modification hooks.
+ (should (or .insert-at .replace))
+ (when .insert-at
+ (goto-char .insert-at)
+ (insert "x"))
+ (when .replace
+ (goto-char (point-min))
+ (search-forward .replace)
+ (replace-match "x"))
+
+ ;; Verify that the expected and actual modification hook
+ ;; calls match.
+ (should (equal
+ .expected-calls
+ (overlay-tests-get-recorded-modification-hooks
+ overlay)))))))))))
(ert-deftest overlay-modification-hooks-message-other-buf ()
"Test for bug#21824.
@@ -274,6 +268,62 @@ with parameters from the *Messages* buffer modification."
(with-temp-buffer
(should (eq (buffer-base-buffer (current-buffer)) nil))))
+(ert-deftest buffer-tests--overlays-indirect-bug58928 ()
+ (with-temp-buffer
+ (insert "hello world")
+ (let* ((base (current-buffer))
+ (ol1 (make-overlay (+ 2 (point-min)) (+ 8 (point-min))))
+ (ib (make-indirect-buffer
+ base (generate-new-buffer-name "bug58928")))
+ (ol2 (with-current-buffer ib
+ (make-overlay (+ 2 (point-min)) (+ 8 (point-min))))))
+ (should (equal (overlay-start ol1) (overlay-start ol2)))
+ (should (equal (overlay-end ol1) (overlay-end ol2)))
+ (goto-char (+ 3 (point-min)))
+ (insert "a") (delete-char 2)
+ (should (equal (overlay-start ol1) (overlay-start ol2)))
+ (should (equal (overlay-end ol1) (overlay-end ol2)))
+ (with-current-buffer ib
+ (goto-char (+ 4 (point-min)))
+ (insert "a") (delete-char 2))
+ (should (equal (overlay-start ol1) (overlay-start ol2)))
+ (should (equal (overlay-end ol1) (overlay-end ol2))))))
+
+(ert-deftest buffer-tests--overlays-indirect-evaporate ()
+ "Verify that deleting text evaporates overlays in every related buffer.
+
+Deleting characters from either a base or an indirect buffer
+should evaporate overlays in both."
+ ;; Loop twice, erasing from the base buffer the first time and the
+ ;; indirect buffer the second.
+ (dolist (erase-where '(base indirect))
+ (ert-info ((format "erase-where %S" erase-where))
+ (with-temp-buffer
+ (insert "xxx")
+ (let* ((beg 2)
+ (end 3)
+ (base (current-buffer))
+ (base-overlay (make-overlay beg end base))
+ (indirect (make-indirect-buffer
+ base
+ (generate-new-buffer-name
+ (concat (buffer-name base) "-indirect"))))
+ (indirect-overlay (make-overlay beg end indirect)))
+ (overlay-put base-overlay 'evaporate t)
+ (overlay-put indirect-overlay 'evaporate t)
+ (with-current-buffer (pcase-exhaustive erase-where
+ (`base base)
+ (`indirect indirect))
+ (delete-region beg end))
+ (ert-info ((prin1-to-string
+ `(,base ,base-overlay ,indirect ,indirect-overlay)))
+ (should (not (buffer-live-p (overlay-buffer base-overlay))))
+ (should (not (buffer-live-p (overlay-buffer indirect-overlay))))
+ (should (equal nil (with-current-buffer base
+ (overlays-in (point-min) (point-max)))))
+ (should (equal nil (with-current-buffer indirect
+ (overlays-in (point-min) (point-max)))))))))))
+
(ert-deftest overlay-evaporation-after-killed-buffer ()
(let* ((ols (with-temp-buffer
(insert "toto")
@@ -859,6 +909,33 @@ with parameters from the *Messages* buffer modification."
(should-length 1 (overlays-at 15))
(should-length 1 (overlays-at (point-max))))))
+(defun sorted-overlays (overlays)
+ (sort
+ (mapcar (lambda (overlay)
+ (list (overlay-start overlay)
+ (overlay-end overlay)))
+ overlays)
+ (lambda (first second)
+ (cl-loop for a in first
+ for b in second
+ thereis (< a b)
+ until (> a b)))))
+
+(defun sorted-overlays-at (pos)
+ (sorted-overlays (overlays-at pos)))
+
+(defun sorted-overlays-in (beg end)
+ (sorted-overlays (overlays-in beg end)))
+
+(ert-deftest test-overlays-at-narrow-to-region-end ()
+ ;; See bug#58703.
+ (with-temp-buffer
+ (insert (make-string 30 ?x))
+ (make-overlay 10 11)
+ (narrow-to-region 10 10)
+ (should (equal
+ '((10 11))
+ (sorted-overlays-at 10)))))
;; +==========================================================================+
;; | overlay-in
@@ -936,6 +1013,39 @@ with parameters from the *Messages* buffer modification."
(deftest-overlays-in-1 ae 9 11 (a) (a 10 10))
(deftest-overlays-in-1 af 10 11 (a) (a 10 10))
+;; behavior for empty range
+(ert-deftest test-overlays-in-empty-range ()
+ (with-temp-buffer
+ (insert (make-string 4 ?x))
+ (cl-loop for start from (point-min) to (point-max)
+ do (cl-loop for end from start to (point-max)
+ do (when (<= start end)
+ (make-overlay start end))))
+
+ (cl-loop for pos from (point-min) to (point-max)
+ do (ert-info ((format "after (overlay-recenter %d)" pos))
+ (overlay-recenter pos)
+ (should (equal
+ '((1 1))
+ (sorted-overlays-in (point-min) (point-min))))
+ (should (equal
+ '((1 3) (1 4) (1 5) (2 2))
+ (sorted-overlays-in 2 2)))
+ (should (equal
+ '((1 4) (1 5) (2 4) (2 5) (3 3))
+ (sorted-overlays-in 3 3)))
+ (should (equal
+ '((1 5) (2 5) (3 5) (4 4))
+ (sorted-overlays-in 4 4)))
+ (should (equal
+ '((5 5))
+ (sorted-overlays-in (point-max) (point-max))))))))
+
+(ert-deftest test-overlays-in-empty-range-bug58672 ()
+ (with-temp-buffer
+ (insert (make-string 10 ?=))
+ (make-overlay 5 7 nil nil t)
+ (should (equal nil (overlays-in 5 5)))))
;; behavior at point-max
(ert-deftest test-overlays-in-2 ()
@@ -1047,6 +1157,49 @@ with parameters from the *Messages* buffer modification."
(should-not (delete-all-overlays))))
+;; +==========================================================================+
+;; | get-pos-property
+;; +==========================================================================+
+
+(ert-deftest get-pos-property-overlay-beg ()
+ "Test `get-pos-property' at the beginning of an overlay.
+Regression test for bug#58706."
+ (with-temp-buffer
+ (insert (make-string 10000 ?x))
+ (let ((overlay (make-overlay 9999 10001)))
+ (overlay-put overlay 'forty-two 42))
+ (should (equal 42 (get-pos-property 9999 'forty-two)))))
+
+(ert-deftest get-pos-property-overlay-empty-rear-advance ()
+ "Test `get-pos-property' at the end of an empty rear-advance overlay.
+Regression test for bug#58706."
+ (with-temp-buffer
+ (insert (make-string 10000 ?x))
+ (let ((overlay (make-overlay 9999 9999 nil nil t)))
+ (overlay-put overlay 'forty-two 42))
+ (should (equal 42 (get-pos-property 9999 'forty-two)))))
+
+(ert-deftest get-pos-property-overlay-past-rear-advance ()
+ "Test `get-pos-property' past the end of an empty rear-advance overlay.
+Regression test for bug#58706."
+ (with-temp-buffer
+ (insert (make-string 10000 ?x))
+ (let ((overlay (make-overlay 9998 9998 nil nil t)))
+ (overlay-put overlay 'forty-two 42))
+ (should (equal nil (get-pos-property 9999 'forty-two)))))
+
+(ert-deftest get-pos-property-overlay-at-narrowed-end ()
+ "Test `get-pos-property' at the end of a narrowed region.
+Regression test for bug#58706."
+ (with-temp-buffer
+ (insert (make-string 11000 ?x))
+ (narrow-to-region 9998 10000)
+ (let ((overlay (make-overlay 10000 10000 nil t nil)))
+ (overlay-put overlay 'forty-two 42))
+ (should (equal nil (get-pos-property 9999 'forty-two)))))
+
+;; FIXME: add more `get-pos-property' tests
+
;; +==========================================================================+
;; | get-char-property(-and-overlay)
;; +==========================================================================+
@@ -1168,7 +1321,51 @@ with parameters from the *Messages* buffer modification."
(delete-overlay left)
(should (= 2 (length (overlays-in 1 (point-max))))))))
+;; +==========================================================================+
+;; | Moving overlays with insert-before-markers
+;; +==========================================================================+
+(ert-deftest test-overlay-insert-before-markers-at-start ()
+ "`insert-before-markers' always advances an overlay's start.
+Test both front-advance and non-front-advance overlays."
+ (dolist (front-advance '(nil t))
+ (ert-info ((format "front-advance %S" front-advance))
+ (with-temp-buffer
+ (insert "1234")
+ (let* ((beg (1+ (point-min)))
+ (end (1+ beg))
+ (overlay (make-overlay beg end nil front-advance nil)))
+ (goto-char beg)
+ (insert-before-markers "x")
+ (should (equal (1+ beg) (overlay-start overlay)))
+ (should (equal (1+ end) (overlay-end overlay))))))))
+
+(ert-deftest test-overlay-insert-before-markers-at-end ()
+ "`insert-before-markers' always advances an overlay's end.
+Test both rear-advance and non-rear-advance overlays."
+ (dolist (rear-advance '(nil t))
+ (ert-info ((format "rear-advance %S" rear-advance))
+ (with-temp-buffer
+ (insert "1234")
+ (let* ((beg (1+ (point-min)))
+ (end (1+ beg))
+ (overlay (make-overlay beg end nil nil rear-advance)))
+ (goto-char end)
+ (insert-before-markers "x")
+ (should (equal beg (overlay-start overlay)))
+ (should (equal (1+ end) (overlay-end overlay))))))))
+
+(ert-deftest test-overlay-insert-before-markers-empty ()
+ (dolist (advance-args '((nil nil) (t nil) (nil t) (t t)))
+ (ert-info ((format "advance args %S" advance-args))
+ (with-temp-buffer
+ (insert "1234")
+ (let* ((pos (1+ (point-min)))
+ (overlay (apply #'make-overlay pos pos nil advance-args)))
+ (goto-char pos)
+ (insert-before-markers "x")
+ (should (equal (1+ pos) (overlay-start overlay)))
+ (should (equal (1+ pos) (overlay-end overlay))))))))
;; +==========================================================================+
;; | Moving by deletions
@@ -1339,6 +1536,14 @@ with parameters from the *Messages* buffer modification."
(overlay-put ov 'value i)))
(should (eq 9 (get-char-property 1 'value)))))
+(ert-deftest buffer-tests--overlay-bug58479 ()
+ (with-temp-buffer
+ (insert "ab")
+ (let* ((pos (+ (point-min) 1))
+ (ol (make-overlay pos pos)))
+ (overlay-put ol 'my-prop 'set)
+ (should (null (get-char-property pos 'my-prop))))))
+
;; +==========================================================================+
;; | Other
@@ -1507,173 +1712,6753 @@ with parameters from the *Messages* buffer
modification."
(ovshould nonempty-eob-end 4 5)
(ovshould empty-eob 5 5)))))
-(ert-deftest buffer-multibyte-overlong-sequences ()
- (dolist (uni '("\xE0\x80\x80"
- "\xF0\x80\x80\x80"
- "\xF8\x8F\xBF\xBF\x80"))
- (let ((multi (string-to-multibyte uni)))
- (should
- (string-equal
- multi
- (with-temp-buffer
- (set-buffer-multibyte nil)
- (insert uni)
- (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'."
+(ert-deftest test-overlay-randomly ()
+ "Exercise overlay code, but perform few assertions.
+
+This test works best when Emacs is configured with
+--enable-checking=yes. This is a little bit like fuzz testing,
+except this test has no way to reduce to a minimal failing test
+case. Regardless, by exercising many corner cases bugs can be
+found using Emacs' internal consistency assertions."
+ (let* (
+ ;; The size and slack for the test buffer size.
+ (buffer-size-target 1000)
+ (buffer-size-slack 200)
+
+ ;; Use up to 100 overlays. We need not use more to observe
+ ;; reasonable variation in the overlay data structures.
+ (overlay-count-limit 100)
+
+ ;; This test maintains a vector of overlays. Each iteration
+ ;; may append or erase one overlay.
+ (overlays (make-vector overlay-count-limit nil))
+ (overlay-count 0)
+
+ ;; The test is either slowly growing or shrinking the overlay
+ ;; count. Deletions still occur while growing, and additions
+ ;; still occur while shrinking. The GROWING variable only
+ ;; controls the relative probability of doing one or the
+ ;; other.
+ (growing t)
+
+ ;; Loop up to 1M times.
+ (iteration-count 0)
+ (iteration-target 100000))
+ (with-temp-buffer
+ (while (< (buffer-size) buffer-size-target)
+ (insert "Sed ut perspiciatis, unde omnis iste natus error sit
voluptatem
+accusantium doloremque laudantium, totam rem aperiam eaque ipsa,
+quae ab illo inventore veritatis et quasi architecto beatae vitae
+dicta sunt, explicabo. "))
+
+ (while (< iteration-count iteration-target)
+ (cl-incf iteration-count)
+
+ ;; Toggle GROWING if we've reached a size boundary. The idea
+ ;; is to initially steadily increase the overlay count, then
+ ;; steadily decrease it, then repeat.
+ (when (and growing (= overlay-count overlay-count-limit))
+ (setq growing nil))
+ (when (and (not growing) (= overlay-count 0))
+ (setq growing t))
+
+ ;; Create or delete a random overlay according to a
+ ;; probability chosen by GROWING.
+ (let ((create-overlay (>= (random 100) (if growing 40 60))))
+ (cond
+ ;; Possibly create a new overlay in a random place in the
+ ;; buffer. We have two easy choices. We can choose the
+ ;; overlay BEGIN randomly, then choose its END among the
+ ;; valid remaining buffer posiitions. Or we could choose
+ ;; the overlay width randomly, then choose a valid BEGIN.
+ ;; We take the former approach, because the overlay data
+ ;; structure is ordered primarily by BEGIN.
+ ((and create-overlay (< overlay-count overlay-count-limit))
+ (let* ((begin (random (buffer-size)))
+ (end (+ begin (random (- (buffer-size) begin))))
+ (ov (make-overlay begin end nil
+ (= 0 (random 2)) (= 0 (random 2)))))
+ (aset overlays overlay-count ov)
+ (cl-incf overlay-count)))
+ ((and (not create-overlay) (> overlay-count 0))
+
+ ;; Possibly delete a random overlay.
+ (let* ((last-index (1- overlay-count))
+ (index (random overlay-count))
+ (ov (aref overlays index)))
+ (when (< index last-index)
+ (aset overlays index (aref overlays last-index)))
+ (aset overlays last-index nil)
+ (cl-decf overlay-count)
+ (delete-overlay ov)))))
+
+ ;; Modify the buffer on occasion, which exercises the
+ ;; insert/remove gap logic in the overlay implementation.
+ (when (and (< (buffer-size) (+ buffer-size-target buffer-size-slack))
+ (zerop (random 10)))
+ (goto-char (1+ (random (buffer-size))))
+ (insert (+ ?a (random 26))))
+ (when (and (> (buffer-size) (- buffer-size-target buffer-size-slack))
+ (zerop (random 10)))
+ (goto-char (1+ (random (buffer-size))))
+ (delete-char 1))))))
+
+
+
+;;
+===================================================================================+
+;; | Autogenerated insert/delete/narrow tests
+;;
+===================================================================================+
+
+(when nil ;; Let's comment these out for now.
+
+;; (defun test-overlay-generate-test (name)
+;; (interactive)
+;; (with-temp-buffer
+;; (let ((forms nil)
+;; (buffer-size 64)
+;; (noverlays 16)
+;; (nforms 32)
+;; (dist '(0.5 0.4 0.1)))
+;; (cl-labels ((brand ()
+;; (+ (point-min)
+;; (random (1+ (- (point-max) (point-min)))))))
+;; (cl-macrolet ((push-eval (form)
+;; `(cl-destructuring-bind (&rest args)
+;; (list ,@(cdr form))
+;; (push (cons ',(car form) args) forms)
+;; (apply #',(car form) args))))
+;; (push-eval (insert (make-string buffer-size ?.)))
+;; (dotimes (_ noverlays)
+;; (push-eval (make-overlay (brand) (brand)
+;; nil
+;; (= 0 (random 2))
+;; (= 0 (random 2)))))
+;; (dotimes (_ nforms)
+;; (push-eval (goto-char (brand)))
+;; (pcase (/ (random 100) 100.0)
+;; ((and x (guard (< x (nth 0 dist))))
+;; (push-eval (insert (make-string (random 16) ?.))))
+;; ((and x (guard (< x (+ (nth 0 dist) (nth 1 dist)))))
+;; (push-eval (delete-char (random (1+ (- (point-max)
(point)))))))
+;; (_
+;; (push-eval (widen))
+;; (push-eval (narrow-to-region (brand) (brand))))))
+;; `(ert-deftest ,name ()
+;; (with-temp-buffer
+;; ,@(nreverse forms)
+;; (should (equal (test-overlay-regions)
+;; ',(test-overlay-regions))))))))))
+
+;; (defun test-overlay-generate-tests (n)
+;; (let ((namefmt "overlay-autogenerated-test-%d")
+;; (standard-output (current-buffer))
+;; (print-length nil)
+;; (print-level nil)
+;; (print-quoted t))
+;; (dotimes (i n)
+;; (pp (test-overlay-generate-test (intern (format namefmt i))))
+;; (terpri))))
+
+;; (progn (random "4711") (test-overlay-generate-tests 64))
+
+(ert-deftest overlay-autogenerated-test-0 nil
(with-temp-buffer
- (should (assq 'buffer-undo-list (buffer-local-variables)))))
-
-(ert-deftest buffer-tests-inhibit-buffer-hooks ()
- "Test `get-buffer-create' argument INHIBIT-BUFFER-HOOKS."
- (let* (run-bluh (bluh (lambda () (setq run-bluh t))))
- (unwind-protect
- (let* ( run-kbh (kbh (lambda () (setq run-kbh t)))
- run-kbqf (kbqf (lambda () (setq run-kbqf t))) )
-
- ;; Inhibited.
- (add-hook 'buffer-list-update-hook bluh)
- (with-current-buffer (generate-new-buffer " foo" t)
- (add-hook 'kill-buffer-hook kbh nil t)
- (add-hook 'kill-buffer-query-functions kbqf nil t)
- (kill-buffer))
- (with-temp-buffer (ignore))
- (with-output-to-string (ignore))
- (should-not run-bluh)
- (should-not run-kbh)
- (should-not run-kbqf)
-
- ;; Not inhibited.
- (with-current-buffer (generate-new-buffer " foo")
- (should run-bluh)
- (add-hook 'kill-buffer-hook kbh nil t)
- (add-hook 'kill-buffer-query-functions kbqf nil t)
- (kill-buffer))
- (should run-kbh)
- (should run-kbqf))
- (remove-hook 'buffer-list-update-hook bluh))))
-
-(ert-deftest buffer-tests-inhibit-buffer-hooks-indirect ()
- "Indirect buffers do not call `get-buffer-create'."
- (dolist (inhibit '(nil t))
- (let ((base (get-buffer-create "foo" inhibit)))
- (unwind-protect
- (dotimes (_i 11)
- (let* (flag*
- (flag (lambda () (prog1 t (setq flag* t))))
- (indirect (make-indirect-buffer base "foo[indirect]" nil
- inhibit)))
- (unwind-protect
- (progn
- (with-current-buffer indirect
- (add-hook 'kill-buffer-query-functions flag nil t))
- (kill-buffer indirect)
- (if inhibit
- (should-not flag*)
- (should flag*)))
- (let (kill-buffer-query-functions)
- (when (buffer-live-p indirect)
- (kill-buffer indirect))))))
- (let (kill-buffer-query-functions)
- (when (buffer-live-p base)
- (kill-buffer base)))))))
-
-(ert-deftest zero-length-overlays-and-not ()
+ (insert "................................................................")
+ (make-overlay 63 7 nil t t)
+ (make-overlay 47 9 nil nil nil)
+ (make-overlay 50 43 nil nil nil)
+ (make-overlay 20 53 nil nil t)
+ (make-overlay 62 4 nil nil t)
+ (make-overlay 40 27 nil t t)
+ (make-overlay 58 44 nil t t)
+ (make-overlay 46 38 nil nil nil)
+ (make-overlay 51 28 nil t nil)
+ (make-overlay 12 53 nil t t)
+ (make-overlay 52 60 nil nil nil)
+ (make-overlay 13 47 nil nil nil)
+ (make-overlay 16 31 nil nil nil)
+ (make-overlay 9 48 nil t t)
+ (make-overlay 43 29 nil nil t)
+ (make-overlay 48 13 nil t nil)
+ (goto-char 44)
+ (delete-char 15)
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 20 8)
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 16)
+ (insert "..............")
+ (goto-char 12)
+ (delete-char 15)
+ (goto-char 12)
+ (delete-char 4)
+ (goto-char 12)
+ (delete-char 0)
+ (goto-char 12)
+ (insert "......")
+ (goto-char 13)
+ (delete-char 5)
+ (goto-char 8)
+ (insert "...")
+ (goto-char 10)
+ (insert ".............")
+ (goto-char 14)
+ (insert ".......")
+ (goto-char 25)
+ (delete-char 4)
+ (goto-char 26)
+ (insert "...............")
+ (goto-char 27)
+ (insert "...")
+ (goto-char 29)
+ (delete-char 7)
+ (goto-char 24)
+ (insert "...")
+ (goto-char 30)
+ (insert "..........")
+ (goto-char 29)
+ (widen)
+ (narrow-to-region 34 41)
+ (goto-char 40)
+ (delete-char 0)
+ (goto-char 35)
+ (delete-char 4)
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 80 66)
+ (goto-char 74)
+ (delete-char 5)
+ (goto-char 69)
+ (delete-char 5)
+ (goto-char 70)
+ (widen)
+ (narrow-to-region 50 71)
+ (goto-char 66)
+ (insert "...............")
+ (goto-char 54)
+ (insert "...............")
+ (goto-char 84)
+ (insert "....")
+ (goto-char 72)
+ (insert "...........")
+ (goto-char 84)
+ (insert "..........")
+ (goto-char 102)
+ (insert "")
+ (goto-char 80)
+ (delete-char 25)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 99)
+ (7 . 100)
+ (48 . 99)
+ (48 . 99)
+ (48 . 99)
+ (49 . 99)
+ (49 . 99)
+ (51 . 80)
+ (51 . 99)
+ (80 . 99)
+ (80 . 99)
+ (80 . 99)
+ (99 . 99)
+ (99 . 99)
+ (99 . 99)
+ (99 . 99))))))
+
+(ert-deftest overlay-autogenerated-test-1 nil
(with-temp-buffer
- (insert "hello")
- (let ((long-overlay (make-overlay 2 4))
- (zero-overlay (make-overlay 3 3)))
- ;; Exclude.
- (should (= (length (overlays-at 3)) 1))
- (should (eq (car (overlays-at 3)) long-overlay))
- ;; Include.
- (should (= (length (overlays-in 3 3)) 2))
- (should (memq long-overlay (overlays-in 3 3)))
- (should (memq zero-overlay (overlays-in 3 3))))))
+ (insert "................................................................")
+ (make-overlay 17 27 nil nil nil)
+ (make-overlay 13 28 nil nil t)
+ (make-overlay 8 56 nil nil nil)
+ (make-overlay 34 64 nil nil nil)
+ (make-overlay 51 4 nil t t)
+ (make-overlay 1 19 nil nil nil)
+ (make-overlay 53 59 nil nil t)
+ (make-overlay 25 13 nil nil nil)
+ (make-overlay 19 28 nil t nil)
+ (make-overlay 33 23 nil t nil)
+ (make-overlay 10 46 nil t t)
+ (make-overlay 18 39 nil nil nil)
+ (make-overlay 1 49 nil t nil)
+ (make-overlay 57 21 nil t t)
+ (make-overlay 10 58 nil t t)
+ (make-overlay 39 49 nil nil t)
+ (goto-char 37)
+ (delete-char 9)
+ (goto-char 3)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 14)
+ (goto-char 18)
+ (insert "..........")
+ (goto-char 53)
+ (insert "....")
+ (goto-char 49)
+ (delete-char 10)
+ (goto-char 11)
+ (delete-char 12)
+ (goto-char 17)
+ (delete-char 22)
+ (goto-char 8)
+ (insert ".")
+ (goto-char 16)
+ (insert "........")
+ (goto-char 16)
+ (delete-char 5)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 22)
+ (insert ".......")
+ (goto-char 18)
+ (delete-char 11)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 9)
+ (insert "...........")
+ (goto-char 7)
+ (insert "...............")
+ (goto-char 2)
+ (insert ".......")
+ (goto-char 21)
+ (delete-char 11)
+ (goto-char 13)
+ (insert "..............")
+ (goto-char 17)
+ (delete-char 3)
+ (goto-char 21)
+ (insert "......")
+ (goto-char 15)
+ (delete-char 32)
+ (goto-char 10)
+ (insert "........")
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 15 20)
+ (goto-char 17)
+ (insert ".............")
+ (goto-char 22)
+ (insert "............")
+ (goto-char 21)
+ (delete-char 8)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 32)
+ (delete-char 2)
+ (goto-char 21)
+ (insert ".....")
+ (goto-char 31)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 58)
+ (1 . 58))))))
-(ert-deftest test-remove-overlays ()
+(ert-deftest overlay-autogenerated-test-2 nil
(with-temp-buffer
- (insert "foo")
- (make-overlay (point) (point))
- (should (= (length (overlays-in (point-min) (point-max))) 1))
- (remove-overlays)
- (should (= (length (overlays-in (point-min) (point-max))) 0)))
-
+ (insert "................................................................")
+ (make-overlay 15 59 nil t t)
+ (make-overlay 56 16 nil nil nil)
+ (make-overlay 65 51 nil t nil)
+ (make-overlay 14 24 nil t nil)
+ (make-overlay 28 9 nil t nil)
+ (make-overlay 58 50 nil t t)
+ (make-overlay 13 32 nil t t)
+ (make-overlay 12 21 nil t nil)
+ (make-overlay 60 23 nil t nil)
+ (make-overlay 39 38 nil nil t)
+ (make-overlay 15 64 nil t nil)
+ (make-overlay 17 21 nil nil t)
+ (make-overlay 46 23 nil t t)
+ (make-overlay 19 40 nil t nil)
+ (make-overlay 13 48 nil nil t)
+ (make-overlay 35 11 nil t nil)
+ (goto-char 41)
+ (delete-char 19)
+ (goto-char 45)
+ (insert "......")
+ (goto-char 3)
+ (delete-char 32)
+ (goto-char 19)
+ (insert "")
+ (goto-char 16)
+ (insert "...............")
+ (goto-char 2)
+ (insert "")
+ (goto-char 30)
+ (delete-char 0)
+ (goto-char 18)
+ (delete-char 17)
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 12)
+ (insert "...")
+ (goto-char 2)
+ (insert ".............")
+ (goto-char 16)
+ (insert ".......")
+ (goto-char 15)
+ (insert ".......")
+ (goto-char 43)
+ (insert "......")
+ (goto-char 22)
+ (insert ".........")
+ (goto-char 25)
+ (delete-char 1)
+ (goto-char 38)
+ (insert "...............")
+ (goto-char 76)
+ (delete-char 3)
+ (goto-char 12)
+ (delete-char 5)
+ (goto-char 70)
+ (delete-char 9)
+ (goto-char 36)
+ (delete-char 4)
+ (goto-char 18)
+ (insert "...............")
+ (goto-char 52)
+ (delete-char 14)
+ (goto-char 23)
+ (insert "..........")
+ (goto-char 64)
+ (insert "...........")
+ (goto-char 68)
+ (delete-char 21)
+ (goto-char 71)
+ (insert "........")
+ (goto-char 28)
+ (delete-char 43)
+ (goto-char 25)
+ (insert "....")
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 40)
+ (insert "....")
+ (goto-char 56)
+ (delete-char 2)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 51)
+ (51 . 58))))))
+
+(ert-deftest overlay-autogenerated-test-3 nil
(with-temp-buffer
- (insert "foo")
+ (insert "................................................................")
+ (make-overlay 53 38 nil t nil)
+ (make-overlay 17 40 nil t t)
+ (make-overlay 64 26 nil t t)
+ (make-overlay 48 24 nil t nil)
+ (make-overlay 21 18 nil nil nil)
+ (make-overlay 2 20 nil nil t)
+ (make-overlay 43 26 nil t t)
+ (make-overlay 56 28 nil t nil)
+ (make-overlay 19 51 nil nil nil)
+ (make-overlay 39 61 nil t nil)
+ (make-overlay 59 12 nil t nil)
+ (make-overlay 65 7 nil t nil)
+ (make-overlay 41 7 nil t nil)
+ (make-overlay 62 50 nil t nil)
+ (make-overlay 7 10 nil t t)
+ (make-overlay 45 28 nil t nil)
+ (goto-char 13)
+ (insert "...")
+ (goto-char 37)
+ (widen)
+ (narrow-to-region 2 10)
+ (goto-char 8)
+ (delete-char 1)
+ (goto-char 3)
+ (delete-char 6)
(goto-char 2)
- (make-overlay (point) (point))
- ;; We only count zero-length overlays at the end of the buffer.
- (should (= (length (overlays-in 1 2)) 0))
- (narrow-to-region 1 2)
- ;; We've now narrowed, so the zero-length overlay is at the end of
- ;; the (accessible part of the) buffer.
- (should (= (length (overlays-in 1 2)) 1))
- (remove-overlays)
- (should (= (length (overlays-in (point-min) (point-max))) 0))))
+ (insert "...........")
+ (goto-char 5)
+ (widen)
+ (narrow-to-region 55 70)
+ (goto-char 55)
+ (insert "......")
+ (goto-char 64)
+ (delete-char 12)
+ (goto-char 61)
+ (insert ".....")
+ (goto-char 64)
+ (insert "..............")
+ (goto-char 72)
+ (delete-char 6)
+ (goto-char 63)
+ (delete-char 12)
+ (goto-char 63)
+ (delete-char 2)
+ (goto-char 57)
+ (insert "..............")
+ (goto-char 68)
+ (insert "........")
+ (goto-char 77)
+ (delete-char 6)
+ (goto-char 77)
+ (insert ".............")
+ (goto-char 67)
+ (delete-char 0)
+ (goto-char 84)
+ (insert "........")
+ (goto-char 74)
+ (delete-char 12)
+ (goto-char 78)
+ (insert "...")
+ (goto-char 80)
+ (insert "............")
+ (goto-char 69)
+ (insert "......")
+ (goto-char 89)
+ (insert ".")
+ (goto-char 56)
+ (insert "....")
+ (goto-char 100)
+ (insert ".............")
+ (goto-char 114)
+ (delete-char 0)
+ (goto-char 61)
+ (widen)
+ (narrow-to-region 94 50)
+ (goto-char 55)
+ (insert "............")
+ (goto-char 53)
+ (insert ".............")
+ (goto-char 116)
+ (delete-char 3)
+ (goto-char 81)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((14 . 166)
+ (16 . 164)
+ (26 . 164)
+ (31 . 68)
+ (33 . 165)
+ (35 . 52)
+ (35 . 164)
+ (45 . 164)
+ (46 . 164))))))
+
+(ert-deftest overlay-autogenerated-test-4 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 25 15 nil nil t)
+ (make-overlay 8 13 nil nil nil)
+ (make-overlay 45 49 nil t t)
+ (make-overlay 22 13 nil t t)
+ (make-overlay 34 17 nil nil t)
+ (make-overlay 42 15 nil nil t)
+ (make-overlay 43 28 nil t t)
+ (make-overlay 3 28 nil t nil)
+ (make-overlay 32 61 nil nil t)
+ (make-overlay 30 64 nil t t)
+ (make-overlay 21 39 nil nil t)
+ (make-overlay 32 62 nil t nil)
+ (make-overlay 25 29 nil t nil)
+ (make-overlay 34 43 nil t nil)
+ (make-overlay 9 11 nil t nil)
+ (make-overlay 21 65 nil nil t)
+ (goto-char 21)
+ (delete-char 4)
+ (goto-char 25)
+ (insert "..")
+ (goto-char 53)
+ (insert "..")
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 42)
+ (delete-char 36)
+ (goto-char 23)
+ (delete-char 12)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 30 32)
+ (goto-char 30)
+ (delete-char 0)
+ (goto-char 31)
+ (delete-char 1)
+ (goto-char 31)
+ (widen)
+ (narrow-to-region 28 27)
+ (goto-char 27)
+ (delete-char 1)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 27)
+ (insert ".")
+ (goto-char 28)
+ (insert "......")
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 27)
+ (delete-char 5)
+ (goto-char 27)
+ (delete-char 1)
+ (goto-char 27)
+ (insert ".............")
+ (goto-char 30)
+ (insert "..............")
+ (goto-char 37)
+ (delete-char 15)
+ (goto-char 32)
+ (delete-char 2)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 34)
+ (delete-char 1)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 24 19)
+ (goto-char 21)
+ (delete-char 1)
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 11 38)
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 20 22)
+ (goto-char 20)
+ (delete-char 1)
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 36 4)
+ (goto-char 26)
+ (delete-char 9)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((18 . 25)
+ (21 . 21)
+ (21 . 21)
+ (21 . 22)
+ (21 . 22)
+ (21 . 27)
+ (21 . 27)
+ (22 . 25)
+ (22 . 27)
+ (22 . 28)
+ (26 . 27))))))
+
+(ert-deftest overlay-autogenerated-test-5 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 64 1 nil nil nil)
+ (make-overlay 38 43 nil nil nil)
+ (make-overlay 42 19 nil t nil)
+ (make-overlay 22 12 nil nil nil)
+ (make-overlay 12 30 nil t t)
+ (make-overlay 38 46 nil nil nil)
+ (make-overlay 18 23 nil nil nil)
+ (make-overlay 58 65 nil nil t)
+ (make-overlay 52 41 nil nil nil)
+ (make-overlay 12 26 nil nil nil)
+ (make-overlay 39 4 nil nil nil)
+ (make-overlay 20 1 nil nil t)
+ (make-overlay 36 60 nil nil nil)
+ (make-overlay 24 18 nil t nil)
+ (make-overlay 9 50 nil nil nil)
+ (make-overlay 19 17 nil t nil)
+ (goto-char 40)
+ (insert "")
+ (goto-char 64)
+ (insert ".............")
+ (goto-char 32)
+ (delete-char 40)
+ (goto-char 25)
+ (insert "...")
+ (goto-char 31)
+ (delete-char 1)
+ (goto-char 8)
+ (delete-char 14)
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 20)
+ (insert "...........")
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 17)
+ (widen)
+ (narrow-to-region 11 21)
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 9 24)
+ (goto-char 24)
+ (insert ".............")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 47 45)
+ (goto-char 47)
+ (insert ".")
+ (goto-char 46)
+ (widen)
+ (narrow-to-region 30 42)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 34)
+ (insert ".......")
+ (goto-char 42)
+ (delete-char 4)
+ (goto-char 39)
+ (delete-char 6)
+ (goto-char 31)
+ (delete-char 6)
+ (goto-char 31)
+ (insert "............")
+ (goto-char 30)
+ (insert "......")
+ (goto-char 50)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "....")
+ (goto-char 53)
+ (insert "............")
+ (goto-char 41)
+ (delete-char 12)
+ (goto-char 52)
+ (insert ".......")
+ (goto-char 56)
+ (insert "...........")
+ (goto-char 68)
+ (insert ".......")
+ (goto-char 52)
+ (insert "......")
+ (goto-char 71)
+ (delete-char 10)
+ (goto-char 47)
+ (insert "")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((20 . 89))))))
-(ert-deftest test-kill-buffer-auto-save-default ()
- (ert-with-temp-file file
- (let (auto-save)
- ;; Always answer yes.
- (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
- (unwind-protect
- (progn
- (find-file file)
- (auto-save-mode t)
- (insert "foo\n")
- (should buffer-auto-save-file-name)
- (setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
- (should (file-exists-p auto-save))
- (kill-buffer (current-buffer))
- (should (file-exists-p auto-save)))
- (when auto-save
- (ignore-errors (delete-file auto-save))))))))
-
-(ert-deftest test-kill-buffer-auto-save-delete ()
- (ert-with-temp-file file
- (let (auto-save)
- (should (file-exists-p file))
- (setq kill-buffer-delete-auto-save-files t)
- ;; Always answer yes.
- (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t)))
- (unwind-protect
- (progn
- (find-file file)
- (auto-save-mode t)
- (insert "foo\n")
- (should buffer-auto-save-file-name)
- (setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
- (should (file-exists-p auto-save))
- ;; This should delete the auto-save file.
- (kill-buffer (current-buffer))
- (should-not (file-exists-p auto-save)))
- (ignore-errors (delete-file file))
- (when auto-save
- (ignore-errors (delete-file auto-save)))))
- ;; Answer no to deletion.
- (cl-letf (((symbol-function #'yes-or-no-p)
- (lambda (prompt)
- (not (string-search "Delete auto-save file" prompt)))))
- (unwind-protect
- (progn
- (find-file file)
- (auto-save-mode t)
- (insert "foo\n")
- (should buffer-auto-save-file-name)
- (setq auto-save buffer-auto-save-file-name)
- (do-auto-save)
- (should (file-exists-p auto-save))
- ;; This should not delete the auto-save file.
- (kill-buffer (current-buffer))
- (should (file-exists-p auto-save)))
- (when auto-save
- (ignore-errors (delete-file auto-save))))))))
+(ert-deftest overlay-autogenerated-test-6 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 28 59 nil nil nil)
+ (make-overlay 36 21 nil t t)
+ (make-overlay 60 19 nil t nil)
+ (make-overlay 26 30 nil t nil)
+ (make-overlay 47 27 nil nil t)
+ (make-overlay 8 25 nil t t)
+ (make-overlay 57 43 nil t t)
+ (make-overlay 28 61 nil nil t)
+ (make-overlay 42 31 nil nil t)
+ (make-overlay 15 44 nil t nil)
+ (make-overlay 56 38 nil nil nil)
+ (make-overlay 39 44 nil nil t)
+ (make-overlay 50 6 nil t nil)
+ (make-overlay 6 19 nil t nil)
+ (make-overlay 50 44 nil t t)
+ (make-overlay 34 60 nil nil t)
+ (goto-char 27)
+ (insert "...............")
+ (goto-char 23)
+ (insert "..............")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 53 67)
+ (goto-char 60)
+ (delete-char 0)
+ (goto-char 54)
+ (insert "......")
+ (goto-char 64)
+ (delete-char 1)
+ (goto-char 66)
+ (delete-char 3)
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 58)
+ (insert ".........")
+ (goto-char 76)
+ (insert "...........")
+ (goto-char 57)
+ (insert "....")
+ (goto-char 106)
+ (widen)
+ (narrow-to-region 5 45)
+ (goto-char 31)
+ (delete-char 8)
+ (goto-char 36)
+ (insert "...")
+ (goto-char 6)
+ (insert "........")
+ (goto-char 33)
+ (insert ".............")
+ (goto-char 38)
+ (delete-char 3)
+ (goto-char 28)
+ (delete-char 6)
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 17 25)
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 22)
+ (delete-char 9)
+ (goto-char 28)
+ (insert "..............")
+ (goto-char 37)
+ (delete-char 3)
+ (goto-char 18)
+ (insert "...............")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 68 25)
+ (goto-char 38)
+ (delete-char 22)
+ (goto-char 43)
+ (widen)
+ (narrow-to-region 47 96)
+ (goto-char 86)
+ (insert ".")
+ (goto-char 63)
+ (insert "......")
+ (goto-char 78)
+ (widen)
+ (narrow-to-region 61 27)
+ (goto-char 43)
+ (delete-char 8)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((14 . 38)
+ (14 . 132)
+ (16 . 43)
+ (38 . 118)
+ (38 . 126)
+ (38 . 142)
+ (44 . 115)
+ (45 . 129))))))
+
+(ert-deftest overlay-autogenerated-test-7 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 13 50 nil t nil)
+ (make-overlay 28 44 nil nil t)
+ (make-overlay 56 27 nil t nil)
+ (make-overlay 8 34 nil nil nil)
+ (make-overlay 22 8 nil nil t)
+ (make-overlay 8 28 nil t nil)
+ (make-overlay 65 31 nil nil t)
+ (make-overlay 44 8 nil nil nil)
+ (make-overlay 52 64 nil nil t)
+ (make-overlay 52 27 nil t t)
+ (make-overlay 47 32 nil nil nil)
+ (make-overlay 18 62 nil nil nil)
+ (make-overlay 18 24 nil t t)
+ (make-overlay 33 46 nil nil t)
+ (make-overlay 20 8 nil t nil)
+ (make-overlay 51 51 nil t nil)
+ (goto-char 2)
+ (delete-char 46)
+ (goto-char 12)
+ (delete-char 5)
+ (goto-char 2)
+ (delete-char 12)
+ (goto-char 2)
+ (insert "..")
+ (goto-char 2)
+ (widen)
+ (narrow-to-region 2 4)
+ (goto-char 4)
+ (insert "......")
+ (goto-char 4)
+ (widen)
+ (narrow-to-region 4 6)
+ (goto-char 5)
+ (insert "")
+ (goto-char 6)
+ (insert "...............")
+ (goto-char 9)
+ (insert "...")
+ (goto-char 7)
+ (delete-char 13)
+ (goto-char 8)
+ (delete-char 1)
+ (goto-char 9)
+ (insert "...............")
+ (goto-char 24)
+ (delete-char 1)
+ (goto-char 15)
+ (insert "...............")
+ (goto-char 16)
+ (insert "............")
+ (goto-char 17)
+ (delete-char 8)
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 47 38)
+ (goto-char 43)
+ (delete-char 0)
+ (goto-char 46)
+ (delete-char 0)
+ (goto-char 40)
+ (delete-char 4)
+ (goto-char 39)
+ (insert ".......")
+ (goto-char 50)
+ (delete-char 0)
+ (goto-char 47)
+ (insert "...........")
+ (goto-char 45)
+ (insert ".....")
+ (goto-char 38)
+ (delete-char 3)
+ (goto-char 59)
+ (delete-char 1)
+ (goto-char 42)
+ (insert "...............")
+ (goto-char 65)
+ (insert "...........")
+ (goto-char 73)
+ (delete-char 13)
+ (goto-char 72)
+ (insert "....")
+ (goto-char 47)
+ (insert "..")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 81)
+ (2 . 81)
+ (2 . 81)
+ (2 . 81)
+ (2 . 81)
+ (81 . 81)
+ (81 . 81))))))
+
+(ert-deftest overlay-autogenerated-test-8 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 20 6 nil t nil)
+ (make-overlay 48 13 nil t nil)
+ (make-overlay 58 65 nil nil t)
+ (make-overlay 63 65 nil nil nil)
+ (make-overlay 42 40 nil t t)
+ (make-overlay 40 6 nil nil t)
+ (make-overlay 37 46 nil t nil)
+ (make-overlay 4 14 nil nil nil)
+ (make-overlay 58 44 nil t t)
+ (make-overlay 14 16 nil nil t)
+ (make-overlay 31 61 nil t nil)
+ (make-overlay 34 3 nil nil nil)
+ (make-overlay 11 16 nil t nil)
+ (make-overlay 19 42 nil nil t)
+ (make-overlay 30 9 nil nil t)
+ (make-overlay 63 52 nil t t)
+ (goto-char 57)
+ (delete-char 2)
+ (goto-char 8)
+ (insert "........")
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 35)
+ (insert "...........")
+ (goto-char 66)
+ (insert "...............")
+ (goto-char 53)
+ (delete-char 15)
+ (goto-char 75)
+ (delete-char 10)
+ (goto-char 62)
+ (delete-char 21)
+ (goto-char 52)
+ (delete-char 10)
+ (goto-char 10)
+ (insert "............")
+ (goto-char 42)
+ (insert "...........")
+ (goto-char 68)
+ (insert ".............")
+ (goto-char 12)
+ (insert "........")
+ (goto-char 1)
+ (insert "...............")
+ (goto-char 89)
+ (insert "")
+ (goto-char 94)
+ (insert ".............")
+ (goto-char 57)
+ (insert "...........")
+ (goto-char 130)
+ (insert "...")
+ (goto-char 69)
+ (insert "..")
+ (goto-char 101)
+ (insert "......")
+ (goto-char 128)
+ (delete-char 13)
+ (goto-char 19)
+ (delete-char 100)
+ (goto-char 22)
+ (insert "..")
+ (goto-char 13)
+ (widen)
+ (narrow-to-region 30 16)
+ (goto-char 19)
+ (insert "..........")
+ (goto-char 22)
+ (delete-char 3)
+ (goto-char 19)
+ (insert ".........")
+ (goto-char 17)
+ (insert "..")
+ (goto-char 16)
+ (insert "............")
+ (goto-char 47)
+ (insert ".")
+ (goto-char 50)
+ (insert "..........")
+ (goto-char 70)
+ (delete-char 1)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((32 . 75)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 60)
+ (33 . 75)
+ (33 . 75)
+ (33 . 75)
+ (60 . 75))))))
+
+(ert-deftest overlay-autogenerated-test-9 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 13 nil nil nil)
+ (make-overlay 29 4 nil nil t)
+ (make-overlay 3 53 nil nil nil)
+ (make-overlay 31 9 nil t t)
+ (make-overlay 48 30 nil nil nil)
+ (make-overlay 43 50 nil nil nil)
+ (make-overlay 7 27 nil nil t)
+ (make-overlay 30 59 nil nil nil)
+ (make-overlay 42 25 nil nil t)
+ (make-overlay 15 13 nil t t)
+ (make-overlay 39 11 nil t t)
+ (make-overlay 21 62 nil t t)
+ (make-overlay 35 2 nil t nil)
+ (make-overlay 60 53 nil nil t)
+ (make-overlay 64 8 nil nil t)
+ (make-overlay 58 59 nil t t)
+ (goto-char 28)
+ (insert ".............")
+ (goto-char 28)
+ (insert "...............")
+ (goto-char 71)
+ (insert ".......")
+ (goto-char 65)
+ (insert "......")
+ (goto-char 3)
+ (delete-char 12)
+ (goto-char 79)
+ (delete-char 11)
+ (goto-char 65)
+ (widen)
+ (narrow-to-region 12 53)
+ (goto-char 38)
+ (insert ".......")
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 27)
+ (insert "...........")
+ (goto-char 75)
+ (insert "........")
+ (goto-char 85)
+ (insert "............")
+ (goto-char 52)
+ (insert "..........")
+ (goto-char 16)
+ (delete-char 8)
+ (goto-char 15)
+ (insert "...............")
+ (goto-char 112)
+ (insert "")
+ (goto-char 61)
+ (insert "..")
+ (goto-char 29)
+ (delete-char 34)
+ (goto-char 52)
+ (delete-char 32)
+ (goto-char 43)
+ (insert "........")
+ (goto-char 45)
+ (insert "..")
+ (goto-char 35)
+ (insert "...........")
+ (goto-char 29)
+ (insert ".......")
+ (goto-char 75)
+ (widen)
+ (narrow-to-region 69 55)
+ (goto-char 67)
+ (delete-char 2)
+ (goto-char 66)
+ (delete-char 0)
+ (goto-char 62)
+ (delete-char 1)
+ (goto-char 61)
+ (delete-char 3)
+ (goto-char 63)
+ (insert ".")
+ (goto-char 56)
+ (insert ".....")
+ (goto-char 67)
+ (insert ".............")
+ (goto-char 76)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 90)
+ (3 . 90)
+ (3 . 90)
+ (3 . 99)
+ (3 . 117)
+ (3 . 117)
+ (3 . 120)
+ (9 . 118)
+ (13 . 102))))))
+
+(ert-deftest overlay-autogenerated-test-10 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 16 60 nil nil nil)
+ (make-overlay 36 53 nil nil nil)
+ (make-overlay 44 39 nil t t)
+ (make-overlay 61 47 nil t t)
+ (make-overlay 58 39 nil nil t)
+ (make-overlay 23 54 nil nil t)
+ (make-overlay 65 59 nil t t)
+ (make-overlay 13 57 nil nil t)
+ (make-overlay 22 64 nil nil t)
+ (make-overlay 16 19 nil nil nil)
+ (make-overlay 16 1 nil nil t)
+ (make-overlay 28 21 nil t t)
+ (make-overlay 10 62 nil nil nil)
+ (make-overlay 12 18 nil nil t)
+ (make-overlay 15 5 nil nil t)
+ (make-overlay 36 31 nil nil t)
+ (goto-char 42)
+ (insert "...")
+ (goto-char 25)
+ (delete-char 28)
+ (goto-char 30)
+ (delete-char 10)
+ (goto-char 8)
+ (delete-char 9)
+ (goto-char 5)
+ (insert "........")
+ (goto-char 6)
+ (delete-char 2)
+ (goto-char 4)
+ (insert "")
+ (goto-char 21)
+ (insert ".............")
+ (goto-char 6)
+ (delete-char 33)
+ (goto-char 1)
+ (delete-char 1)
+ (goto-char 6)
+ (insert "..........")
+ (goto-char 8)
+ (insert "...........")
+ (goto-char 21)
+ (insert "........")
+ (goto-char 16)
+ (delete-char 18)
+ (goto-char 5)
+ (insert "...")
+ (goto-char 5)
+ (delete-char 8)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 9)
+ (delete-char 9)
+ (goto-char 5)
+ (insert "")
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 12)
+ (insert "")
+ (goto-char 11)
+ (delete-char 8)
+ (goto-char 7)
+ (delete-char 3)
+ (goto-char 5)
+ (delete-char 3)
+ (goto-char 1)
+ (delete-char 8)
+ (goto-char 1)
+ (insert "....")
+ (goto-char 1)
+ (insert "..")
+ (goto-char 7)
+ (insert "...")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 9 11)
+ (goto-char 11)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 10)
+ (1 . 10)
+ (1 . 10)
+ (1 . 10)
+ (1 . 10)
+ (1 . 12)
+ (1 . 12)
+ (1 . 12)
+ (10 . 10)
+ (10 . 10)
+ (10 . 12))))))
+
+(ert-deftest overlay-autogenerated-test-11 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 33 18 nil nil nil)
+ (make-overlay 56 38 nil t nil)
+ (make-overlay 2 45 nil nil t)
+ (make-overlay 19 55 nil nil t)
+ (make-overlay 28 42 nil t t)
+ (make-overlay 50 29 nil t nil)
+ (make-overlay 40 63 nil nil nil)
+ (make-overlay 13 2 nil nil t)
+ (make-overlay 26 7 nil t t)
+ (make-overlay 22 25 nil nil nil)
+ (make-overlay 14 14 nil t nil)
+ (make-overlay 15 39 nil t t)
+ (make-overlay 51 22 nil t t)
+ (make-overlay 58 5 nil t nil)
+ (make-overlay 16 10 nil nil nil)
+ (make-overlay 32 33 nil t nil)
+ (goto-char 40)
+ (delete-char 20)
+ (goto-char 45)
+ (delete-char 0)
+ (goto-char 6)
+ (insert "..")
+ (goto-char 45)
+ (insert "...")
+ (goto-char 26)
+ (insert "...............")
+ (goto-char 27)
+ (insert "...........")
+ (goto-char 38)
+ (insert "......")
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 18)
+ (insert "...........")
+ (goto-char 99)
+ (widen)
+ (narrow-to-region 37 17)
+ (goto-char 29)
+ (delete-char 2)
+ (goto-char 28)
+ (delete-char 2)
+ (goto-char 17)
+ (insert ".....")
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 34 96)
+ (goto-char 44)
+ (delete-char 22)
+ (goto-char 39)
+ (insert "..")
+ (goto-char 53)
+ (insert "...............")
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 93)
+ (insert ".........")
+ (goto-char 78)
+ (widen)
+ (narrow-to-region 27 104)
+ (goto-char 93)
+ (delete-char 11)
+ (goto-char 59)
+ (insert "....")
+ (goto-char 59)
+ (insert "..............")
+ (goto-char 74)
+ (delete-char 5)
+ (goto-char 70)
+ (insert ".")
+ (goto-char 37)
+ (insert "...........")
+ (goto-char 34)
+ (delete-char 46)
+ (goto-char 49)
+ (insert "......")
+ (goto-char 55)
+ (insert "...")
+ (goto-char 42)
+ (insert "...")
+ (goto-char 70)
+ (delete-char 8)
+ (goto-char 48)
+ (delete-char 28)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 62)
+ (5 . 62)
+ (9 . 34)
+ (22 . 61)
+ (33 . 55)
+ (33 . 62)
+ (34 . 34)
+ (34 . 62))))))
+
+(ert-deftest overlay-autogenerated-test-12 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 18 50 nil nil nil)
+ (make-overlay 63 3 nil nil t)
+ (make-overlay 44 20 nil t t)
+ (make-overlay 58 38 nil nil t)
+ (make-overlay 3 17 nil t nil)
+ (make-overlay 31 62 nil t nil)
+ (make-overlay 12 17 nil t nil)
+ (make-overlay 17 52 nil nil nil)
+ (make-overlay 9 35 nil nil nil)
+ (make-overlay 17 38 nil nil nil)
+ (make-overlay 53 54 nil nil t)
+ (make-overlay 65 34 nil t nil)
+ (make-overlay 12 33 nil t nil)
+ (make-overlay 54 58 nil nil nil)
+ (make-overlay 42 26 nil t nil)
+ (make-overlay 2 4 nil t nil)
+ (goto-char 4)
+ (delete-char 26)
+ (goto-char 39)
+ (insert ".")
+ (goto-char 2)
+ (delete-char 14)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 19 1)
+ (goto-char 7)
+ (delete-char 9)
+ (goto-char 6)
+ (insert ".........")
+ (goto-char 6)
+ (insert "..........")
+ (goto-char 16)
+ (insert ".............")
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 4)
+ (insert "..........")
+ (goto-char 49)
+ (delete-char 2)
+ (goto-char 16)
+ (insert "............")
+ (goto-char 52)
+ (widen)
+ (narrow-to-region 36 38)
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 37)
+ (insert ".............")
+ (goto-char 46)
+ (insert ".")
+ (goto-char 40)
+ (delete-char 5)
+ (goto-char 45)
+ (delete-char 0)
+ (goto-char 46)
+ (delete-char 0)
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 39)
+ (delete-char 4)
+ (goto-char 39)
+ (delete-char 3)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 8 9)
+ (goto-char 8)
+ (delete-char 1)
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 45 15)
+ (goto-char 40)
+ (insert "...............")
+ (goto-char 29)
+ (delete-char 7)
+ (goto-char 30)
+ (delete-char 6)
+ (goto-char 21)
+ (delete-char 9)
+ (goto-char 22)
+ (insert "...............")
+ (goto-char 51)
+ (insert "..............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 92)
+ (2 . 92)
+ (2 . 93)
+ (2 . 96)
+ (2 . 97)
+ (2 . 99))))))
+
+(ert-deftest overlay-autogenerated-test-13 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 18 30 nil t t)
+ (make-overlay 54 37 nil nil t)
+ (make-overlay 16 61 nil nil t)
+ (make-overlay 58 7 nil nil t)
+ (make-overlay 27 39 nil nil t)
+ (make-overlay 39 31 nil nil t)
+ (make-overlay 11 47 nil nil nil)
+ (make-overlay 47 40 nil t t)
+ (make-overlay 27 18 nil nil nil)
+ (make-overlay 33 26 nil nil t)
+ (make-overlay 55 4 nil t t)
+ (make-overlay 62 50 nil t t)
+ (make-overlay 47 65 nil t t)
+ (make-overlay 17 23 nil nil t)
+ (make-overlay 30 31 nil t nil)
+ (make-overlay 10 37 nil t nil)
+ (goto-char 8)
+ (delete-char 6)
+ (goto-char 56)
+ (delete-char 0)
+ (goto-char 28)
+ (insert ".........")
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 4)
+ (delete-char 28)
+ (goto-char 49)
+ (delete-char 4)
+ (goto-char 2)
+ (insert "............")
+ (goto-char 10)
+ (delete-char 37)
+ (goto-char 19)
+ (delete-char 2)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "..")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 12 3)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 9)
+ (insert "..")
+ (goto-char 12)
+ (insert "...............")
+ (goto-char 25)
+ (insert ".....")
+ (goto-char 10)
+ (widen)
+ (narrow-to-region 42 18)
+ (goto-char 20)
+ (insert ".......")
+ (goto-char 18)
+ (insert ".........")
+ (goto-char 55)
+ (delete-char 3)
+ (goto-char 48)
+ (insert ".......")
+ (goto-char 52)
+ (delete-char 6)
+ (goto-char 45)
+ (delete-char 11)
+ (goto-char 27)
+ (delete-char 13)
+ (goto-char 22)
+ (insert "...........")
+ (goto-char 19)
+ (delete-char 15)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 12 25)
+ (goto-char 16)
+ (insert "..........")
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 2 38)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 31)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((12 . 12)
+ (12 . 12)
+ (12 . 12)
+ (12 . 12)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 53)
+ (12 . 55))))))
+
+(ert-deftest overlay-autogenerated-test-14 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 29 37 nil t nil)
+ (make-overlay 15 44 nil nil nil)
+ (make-overlay 31 34 nil nil t)
+ (make-overlay 35 33 nil t t)
+ (make-overlay 4 27 nil t t)
+ (make-overlay 37 5 nil nil t)
+ (make-overlay 58 19 nil nil t)
+ (make-overlay 57 47 nil nil t)
+ (make-overlay 49 5 nil t t)
+ (make-overlay 21 59 nil t t)
+ (make-overlay 42 33 nil t nil)
+ (make-overlay 22 16 nil t t)
+ (make-overlay 9 51 nil t nil)
+ (make-overlay 20 24 nil nil t)
+ (make-overlay 21 7 nil t t)
+ (make-overlay 58 52 nil t t)
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 55 54)
+ (goto-char 54)
+ (insert ".............")
+ (goto-char 55)
+ (insert "............")
+ (goto-char 66)
+ (delete-char 10)
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 82)
+ (delete-char 2)
+ (goto-char 82)
+ (delete-char 0)
+ (goto-char 76)
+ (insert "..............")
+ (goto-char 60)
+ (insert ".............")
+ (goto-char 71)
+ (insert "...............")
+ (goto-char 122)
+ (delete-char 0)
+ (goto-char 93)
+ (delete-char 3)
+ (goto-char 108)
+ (delete-char 1)
+ (goto-char 121)
+ (insert "........")
+ (goto-char 92)
+ (insert "")
+ (goto-char 103)
+ (insert "..........")
+ (goto-char 85)
+ (delete-char 13)
+ (goto-char 116)
+ (delete-char 7)
+ (goto-char 103)
+ (widen)
+ (narrow-to-region 60 27)
+ (goto-char 28)
+ (delete-char 16)
+ (goto-char 35)
+ (insert ".......")
+ (goto-char 47)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 59)
+ (insert "........")
+ (goto-char 57)
+ (insert "........")
+ (goto-char 36)
+ (insert "...........")
+ (goto-char 82)
+ (delete-char 11)
+ (goto-char 67)
+ (insert "..........")
+ (goto-char 46)
+ (delete-char 1)
+ (goto-char 47)
+ (insert "......")
+ (goto-char 69)
+ (delete-char 7)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 28)
+ (5 . 33)
+ (9 . 35)
+ (15 . 28)
+ (19 . 154)
+ (21 . 155)
+ (28 . 28)
+ (28 . 28)
+ (28 . 28)
+ (28 . 28)
+ (31 . 153)
+ (58 . 154))))))
+
+(ert-deftest overlay-autogenerated-test-15 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 3 19 nil t t)
+ (make-overlay 11 18 nil t nil)
+ (make-overlay 28 51 nil nil t)
+ (make-overlay 29 15 nil t t)
+ (make-overlay 46 57 nil t t)
+ (make-overlay 26 24 nil nil nil)
+ (make-overlay 29 43 nil nil nil)
+ (make-overlay 54 29 nil nil nil)
+ (make-overlay 34 52 nil t nil)
+ (make-overlay 10 32 nil nil nil)
+ (make-overlay 28 34 nil nil t)
+ (make-overlay 11 43 nil nil nil)
+ (make-overlay 18 50 nil t t)
+ (make-overlay 28 39 nil nil nil)
+ (make-overlay 62 62 nil t t)
+ (make-overlay 30 62 nil t nil)
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 6 22)
+ (goto-char 9)
+ (insert "..")
+ (goto-char 12)
+ (insert ".............")
+ (goto-char 29)
+ (insert "..............")
+ (goto-char 47)
+ (insert "........")
+ (goto-char 46)
+ (insert ".............")
+ (goto-char 55)
+ (insert "..........")
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 47)
+ (delete-char 49)
+ (goto-char 11)
+ (insert "...........")
+ (goto-char 40)
+ (delete-char 1)
+ (goto-char 27)
+ (insert "..............")
+ (goto-char 51)
+ (insert "......")
+ (goto-char 60)
+ (delete-char 10)
+ (goto-char 37)
+ (insert ".........")
+ (goto-char 69)
+ (insert ".")
+ (goto-char 36)
+ (insert "............")
+ (goto-char 75)
+ (insert ".............")
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 44 21)
+ (goto-char 37)
+ (insert ".............")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 84 28)
+ (goto-char 58)
+ (widen)
+ (narrow-to-region 96 49)
+ (goto-char 62)
+ (delete-char 0)
+ (goto-char 72)
+ (delete-char 24)
+ (goto-char 61)
+ (widen)
+ (narrow-to-region 105 83)
+ (goto-char 96)
+ (widen)
+ (narrow-to-region 109 46)
+ (goto-char 95)
+ (delete-char 4)
+ (goto-char 81)
+ (insert ".")
+ (goto-char 51)
+ (delete-char 8)
+ (goto-char 52)
+ (insert ".")
+ (goto-char 60)
+ (delete-char 10)
+ (goto-char 50)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 81)
+ (23 . 88)
+ (66 . 99)
+ (69 . 81)
+ (78 . 85)
+ (81 . 106)
+ (84 . 85)
+ (85 . 90)
+ (85 . 95)
+ (85 . 99)
+ (85 . 107)
+ (85 . 110)
+ (86 . 118)
+ (90 . 108))))))
+
+(ert-deftest overlay-autogenerated-test-16 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 3 55 nil t nil)
+ (make-overlay 45 47 nil nil nil)
+ (make-overlay 23 57 nil t t)
+ (make-overlay 64 55 nil nil nil)
+ (make-overlay 37 26 nil t t)
+ (make-overlay 29 38 nil nil t)
+ (make-overlay 33 3 nil t t)
+ (make-overlay 49 16 nil t nil)
+ (make-overlay 35 56 nil t t)
+ (make-overlay 9 39 nil nil nil)
+ (make-overlay 2 61 nil nil nil)
+ (make-overlay 59 26 nil nil t)
+ (make-overlay 5 50 nil t t)
+ (make-overlay 19 19 nil nil t)
+ (make-overlay 64 21 nil t nil)
+ (make-overlay 21 8 nil nil t)
+ (goto-char 17)
+ (insert ".....")
+ (goto-char 29)
+ (insert "............")
+ (goto-char 42)
+ (delete-char 38)
+ (goto-char 24)
+ (insert "")
+ (goto-char 9)
+ (delete-char 2)
+ (goto-char 20)
+ (insert "..")
+ (goto-char 27)
+ (delete-char 8)
+ (goto-char 25)
+ (delete-char 6)
+ (goto-char 8)
+ (delete-char 21)
+ (goto-char 9)
+ (insert "..............")
+ (goto-char 3)
+ (insert "....")
+ (goto-char 8)
+ (delete-char 18)
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 5 8)
+ (goto-char 5)
+ (delete-char 3)
+ (goto-char 5)
+ (insert "...")
+ (goto-char 8)
+ (insert "..........")
+ (goto-char 5)
+ (insert "")
+ (goto-char 7)
+ (delete-char 8)
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 2 2)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 0)
+ (goto-char 2)
+ (widen)
+ (narrow-to-region 10 3)
+ (goto-char 8)
+ (delete-char 2)
+ (goto-char 7)
+ (insert ".......")
+ (goto-char 8)
+ (delete-char 3)
+ (goto-char 12)
+ (insert "..")
+ (goto-char 9)
+ (delete-char 2)
+ (goto-char 7)
+ (insert "......")
+ (goto-char 15)
+ (insert "..........")
+ (goto-char 4)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 13)
+ (13 . 36)
+ (13 . 36)
+ (13 . 36)
+ (13 . 36))))))
+
+(ert-deftest overlay-autogenerated-test-17 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 15 37 nil t nil)
+ (make-overlay 40 3 nil t t)
+ (make-overlay 61 19 nil t t)
+ (make-overlay 46 9 nil nil t)
+ (make-overlay 64 39 nil nil t)
+ (make-overlay 50 58 nil nil t)
+ (make-overlay 21 30 nil t nil)
+ (make-overlay 44 54 nil t nil)
+ (make-overlay 32 2 nil t nil)
+ (make-overlay 14 9 nil t t)
+ (make-overlay 41 40 nil t nil)
+ (make-overlay 17 26 nil t nil)
+ (make-overlay 57 50 nil t t)
+ (make-overlay 16 65 nil nil t)
+ (make-overlay 13 61 nil t t)
+ (make-overlay 39 64 nil nil t)
+ (goto-char 37)
+ (widen)
+ (narrow-to-region 12 1)
+ (goto-char 12)
+ (insert "......")
+ (goto-char 8)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 3)
+ (goto-char 6)
+ (insert ".....")
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 53 48)
+ (goto-char 48)
+ (delete-char 5)
+ (goto-char 48)
+ (widen)
+ (narrow-to-region 59 58)
+ (goto-char 59)
+ (delete-char 0)
+ (goto-char 58)
+ (insert "...")
+ (goto-char 60)
+ (insert "...............")
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 67)
+ (insert ".....")
+ (goto-char 73)
+ (insert "")
+ (goto-char 68)
+ (insert ".....")
+ (goto-char 64)
+ (insert "....")
+ (goto-char 62)
+ (insert "..")
+ (goto-char 91)
+ (insert "..........")
+ (goto-char 80)
+ (insert "............")
+ (goto-char 100)
+ (delete-char 21)
+ (goto-char 74)
+ (insert "...")
+ (goto-char 60)
+ (delete-char 30)
+ (goto-char 64)
+ (widen)
+ (narrow-to-region 71 23)
+ (goto-char 53)
+ (delete-char 11)
+ (goto-char 23)
+ (delete-char 21)
+ (goto-char 39)
+ (delete-char 0)
+ (goto-char 35)
+ (insert "")
+ (goto-char 35)
+ (insert ".........")
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 35)
+ (insert "..")
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 28)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((13 . 27)
+ (17 . 67)
+ (20 . 71)
+ (23 . 23)
+ (23 . 24)
+ (23 . 67)
+ (23 . 70)
+ (23 . 70)
+ (27 . 41)
+ (28 . 41)
+ (28 . 41))))))
+
+(ert-deftest overlay-autogenerated-test-18 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 43 52 nil nil t)
+ (make-overlay 27 29 nil nil t)
+ (make-overlay 24 18 nil nil nil)
+ (make-overlay 39 52 nil nil nil)
+ (make-overlay 33 62 nil t t)
+ (make-overlay 16 7 nil t nil)
+ (make-overlay 47 39 nil nil t)
+ (make-overlay 59 41 nil nil nil)
+ (make-overlay 22 55 nil nil t)
+ (make-overlay 60 16 nil t t)
+ (make-overlay 55 20 nil nil t)
+ (make-overlay 25 12 nil nil t)
+ (make-overlay 26 2 nil nil t)
+ (make-overlay 17 35 nil nil t)
+ (make-overlay 46 41 nil t nil)
+ (make-overlay 57 53 nil t t)
+ (goto-char 52)
+ (insert "")
+ (goto-char 4)
+ (delete-char 21)
+ (goto-char 17)
+ (insert "")
+ (goto-char 35)
+ (insert "...............")
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 9)
+ (insert "........")
+ (goto-char 73)
+ (delete-char 9)
+ (goto-char 62)
+ (insert "...............")
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 34 84)
+ (goto-char 81)
+ (insert "...........")
+ (goto-char 48)
+ (insert "...")
+ (goto-char 74)
+ (insert ".......")
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 37 105)
+ (goto-char 75)
+ (insert "...............")
+ (goto-char 47)
+ (insert "..........")
+ (goto-char 99)
+ (delete-char 13)
+ (goto-char 105)
+ (delete-char 4)
+ (goto-char 94)
+ (delete-char 5)
+ (goto-char 96)
+ (insert "..............")
+ (goto-char 74)
+ (insert "")
+ (goto-char 121)
+ (insert "...")
+ (goto-char 102)
+ (insert "...")
+ (goto-char 64)
+ (insert "......")
+ (goto-char 67)
+ (insert "...")
+ (goto-char 95)
+ (delete-char 19)
+ (goto-char 37)
+ (insert "..........")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 67 96)
+ (goto-char 88)
+ (insert "..........")
+ (goto-char 91)
+ (insert ".............")
+ (goto-char 70)
+ (delete-char 8)
+ (goto-char 111)
+ (widen)
+ (narrow-to-region 72 103)
+ (goto-char 101)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 119)
+ (4 . 119)
+ (4 . 162)
+ (35 . 162)
+ (51 . 78)
+ (53 . 162)
+ (55 . 78)
+ (79 . 162))))))
+
+(ert-deftest overlay-autogenerated-test-19 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 19 31 nil t t)
+ (make-overlay 40 5 nil nil nil)
+ (make-overlay 13 41 nil t t)
+ (make-overlay 41 43 nil nil t)
+ (make-overlay 7 60 nil t nil)
+ (make-overlay 40 23 nil t nil)
+ (make-overlay 32 15 nil t t)
+ (make-overlay 12 45 nil nil nil)
+ (make-overlay 18 1 nil nil nil)
+ (make-overlay 58 32 nil t t)
+ (make-overlay 30 3 nil t t)
+ (make-overlay 43 61 nil t nil)
+ (make-overlay 54 57 nil nil t)
+ (make-overlay 34 14 nil t t)
+ (make-overlay 26 49 nil nil t)
+ (make-overlay 54 49 nil nil t)
+ (goto-char 28)
+ (insert "........")
+ (goto-char 32)
+ (insert "...........")
+ (goto-char 78)
+ (delete-char 6)
+ (goto-char 37)
+ (delete-char 0)
+ (goto-char 49)
+ (insert ".........")
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 8 30)
+ (goto-char 20)
+ (delete-char 4)
+ (goto-char 23)
+ (delete-char 1)
+ (goto-char 10)
+ (insert ".")
+ (goto-char 22)
+ (delete-char 2)
+ (goto-char 22)
+ (insert "......")
+ (goto-char 17)
+ (insert "..........")
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 21)
+ (insert "............")
+ (goto-char 45)
+ (delete-char 7)
+ (goto-char 39)
+ (insert "...............")
+ (goto-char 29)
+ (insert "........")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 63)
+ (delete-char 1)
+ (goto-char 33)
+ (insert "........")
+ (goto-char 16)
+ (delete-char 36)
+ (goto-char 20)
+ (delete-char 2)
+ (goto-char 28)
+ (delete-char 0)
+ (goto-char 24)
+ (insert "...........")
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 30)
+ (delete-char 1)
+ (goto-char 40)
+ (delete-char 13)
+ (goto-char 22)
+ (delete-char 19)
+ (goto-char 10)
+ (delete-char 8)
+ (goto-char 14)
+ (delete-char 0)
+ (goto-char 12)
+ (delete-char 2)
+ (goto-char 11)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 12)
+ (3 . 40)
+ (5 . 50)
+ (7 . 69)
+ (10 . 42)
+ (10 . 44)
+ (10 . 51)
+ (10 . 55))))))
+
+(ert-deftest overlay-autogenerated-test-20 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 44 42 nil t t)
+ (make-overlay 47 1 nil nil nil)
+ (make-overlay 24 48 nil nil nil)
+ (make-overlay 62 50 nil nil t)
+ (make-overlay 54 38 nil nil nil)
+ (make-overlay 3 9 nil nil nil)
+ (make-overlay 61 28 nil t nil)
+ (make-overlay 33 33 nil nil t)
+ (make-overlay 37 37 nil t nil)
+ (make-overlay 20 13 nil nil t)
+ (make-overlay 54 36 nil t nil)
+ (make-overlay 18 58 nil nil t)
+ (make-overlay 55 3 nil nil t)
+ (make-overlay 23 21 nil t t)
+ (make-overlay 47 55 nil t t)
+ (make-overlay 50 12 nil nil nil)
+ (goto-char 11)
+ (delete-char 46)
+ (goto-char 7)
+ (delete-char 3)
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 14)
+ (insert "......")
+ (goto-char 14)
+ (delete-char 4)
+ (goto-char 12)
+ (widen)
+ (narrow-to-region 11 12)
+ (goto-char 11)
+ (insert "...")
+ (goto-char 13)
+ (delete-char 1)
+ (goto-char 14)
+ (insert ".")
+ (goto-char 13)
+ (delete-char 2)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 11)
+ (insert "")
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 11)
+ (insert ".")
+ (goto-char 12)
+ (insert "......")
+ (goto-char 14)
+ (delete-char 2)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 14)
+ (insert "............")
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 29)
+ (insert ".....")
+ (goto-char 42)
+ (delete-char 1)
+ (goto-char 22)
+ (insert ".....")
+ (goto-char 19)
+ (insert "..............")
+ (goto-char 42)
+ (insert ".....")
+ (goto-char 63)
+ (widen)
+ (narrow-to-region 26 42)
+ (goto-char 36)
+ (insert "..........")
+ (goto-char 40)
+ (delete-char 11)
+ (goto-char 26)
+ (delete-char 13)
+ (goto-char 28)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((8 . 56))))))
+
+(ert-deftest overlay-autogenerated-test-21 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 65 15 nil nil nil)
+ (make-overlay 52 31 nil nil nil)
+ (make-overlay 12 51 nil t t)
+ (make-overlay 42 20 nil nil t)
+ (make-overlay 51 48 nil nil nil)
+ (make-overlay 59 28 nil t t)
+ (make-overlay 51 53 nil t nil)
+ (make-overlay 50 59 nil nil t)
+ (make-overlay 24 40 nil t nil)
+ (make-overlay 51 61 nil nil nil)
+ (make-overlay 12 58 nil nil t)
+ (make-overlay 64 17 nil t t)
+ (make-overlay 26 38 nil t t)
+ (make-overlay 23 36 nil nil nil)
+ (make-overlay 57 50 nil nil nil)
+ (make-overlay 42 15 nil nil t)
+ (goto-char 14)
+ (insert "............")
+ (goto-char 37)
+ (insert ".")
+ (goto-char 73)
+ (insert "..........")
+ (goto-char 17)
+ (delete-char 31)
+ (goto-char 21)
+ (delete-char 35)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 7)
+ (delete-char 2)
+ (goto-char 1)
+ (insert "")
+ (goto-char 5)
+ (insert ".......")
+ (goto-char 8)
+ (insert "....")
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 10)
+ (insert ".............")
+ (goto-char 24)
+ (delete-char 16)
+ (goto-char 14)
+ (insert ".............")
+ (goto-char 25)
+ (delete-char 11)
+ (goto-char 3)
+ (insert "........")
+ (goto-char 38)
+ (insert "............")
+ (goto-char 41)
+ (insert "..............")
+ (goto-char 56)
+ (delete-char 3)
+ (goto-char 15)
+ (widen)
+ (narrow-to-region 16 53)
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 18 33)
+ (goto-char 32)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 11 11)
+ (goto-char 11)
+ (insert ".........")
+ (goto-char 11)
+ (insert ".........")
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 22 69)
+ (goto-char 49)
+ (insert ".........")
+ (goto-char 54)
+ (delete-char 22)
+ (goto-char 44)
+ (insert "........")
+ (goto-char 40)
+ (delete-char 7)
+ (goto-char 29)
+ (delete-char 22)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33)
+ (33 . 33))))))
+
+(ert-deftest overlay-autogenerated-test-22 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 12 14 nil nil t)
+ (make-overlay 54 7 nil nil t)
+ (make-overlay 8 3 nil nil nil)
+ (make-overlay 42 32 nil nil nil)
+ (make-overlay 10 27 nil t t)
+ (make-overlay 50 28 nil t t)
+ (make-overlay 39 35 nil nil nil)
+ (make-overlay 12 4 nil t t)
+ (make-overlay 29 54 nil nil nil)
+ (make-overlay 14 52 nil t t)
+ (make-overlay 9 15 nil t nil)
+ (make-overlay 44 11 nil nil nil)
+ (make-overlay 46 29 nil t t)
+ (make-overlay 40 58 nil t t)
+ (make-overlay 40 61 nil t nil)
+ (make-overlay 13 59 nil nil t)
+ (goto-char 32)
+ (insert ".............")
+ (goto-char 25)
+ (delete-char 10)
+ (goto-char 3)
+ (insert ".............")
+ (goto-char 33)
+ (delete-char 32)
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 41 46)
+ (goto-char 43)
+ (delete-char 2)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 42)
+ (insert "...")
+ (goto-char 43)
+ (delete-char 1)
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 8 46)
+ (goto-char 25)
+ (delete-char 7)
+ (goto-char 12)
+ (delete-char 10)
+ (goto-char 23)
+ (insert "...............")
+ (goto-char 41)
+ (delete-char 3)
+ (goto-char 17)
+ (insert ".........")
+ (goto-char 37)
+ (insert "...............")
+ (goto-char 53)
+ (delete-char 7)
+ (goto-char 53)
+ (delete-char 0)
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 20 54)
+ (goto-char 20)
+ (delete-char 28)
+ (goto-char 23)
+ (insert "..........")
+ (goto-char 30)
+ (insert "......")
+ (goto-char 26)
+ (delete-char 1)
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 40 37)
+ (goto-char 37)
+ (insert ".....")
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 13 37)
+ (goto-char 29)
+ (insert "...........")
+ (goto-char 33)
+ (delete-char 7)
+ (goto-char 33)
+ (delete-char 8)
+ (goto-char 20)
+ (insert "")
+ (goto-char 23)
+ (delete-char 7)
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 33 33)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((15 . 39)
+ (16 . 38)
+ (16 . 39))))))
+
+(ert-deftest overlay-autogenerated-test-23 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 51 32 nil t t)
+ (make-overlay 13 61 nil t nil)
+ (make-overlay 47 19 nil nil t)
+ (make-overlay 11 30 nil nil nil)
+ (make-overlay 50 26 nil t t)
+ (make-overlay 64 13 nil t t)
+ (make-overlay 29 8 nil t t)
+ (make-overlay 25 42 nil t t)
+ (make-overlay 33 28 nil t t)
+ (make-overlay 54 7 nil nil nil)
+ (make-overlay 30 59 nil nil nil)
+ (make-overlay 65 50 nil t t)
+ (make-overlay 64 15 nil t nil)
+ (make-overlay 16 35 nil nil nil)
+ (make-overlay 40 36 nil nil t)
+ (make-overlay 31 35 nil t nil)
+ (goto-char 61)
+ (insert "......")
+ (goto-char 55)
+ (delete-char 2)
+ (goto-char 20)
+ (insert "..............")
+ (goto-char 56)
+ (insert "............")
+ (goto-char 48)
+ (delete-char 6)
+ (goto-char 9)
+ (delete-char 54)
+ (goto-char 20)
+ (delete-char 2)
+ (goto-char 16)
+ (delete-char 12)
+ (goto-char 18)
+ (insert ".............")
+ (goto-char 24)
+ (delete-char 7)
+ (goto-char 5)
+ (delete-char 2)
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 33)
+ (insert "")
+ (goto-char 4)
+ (insert "..")
+ (goto-char 5)
+ (widen)
+ (narrow-to-region 17 4)
+ (goto-char 13)
+ (insert ".")
+ (goto-char 8)
+ (insert "............")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 4)
+ (widen)
+ (narrow-to-region 32 32)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 43)
+ (delete-char 4)
+ (goto-char 32)
+ (delete-char 1)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 33 19)
+ (goto-char 27)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 2)
+ (goto-char 26)
+ (insert "")
+ (goto-char 33)
+ (delete-char 1)
+ (goto-char 27)
+ (insert ".")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((38 . 56))))))
+
+(ert-deftest overlay-autogenerated-test-24 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 63 8 nil t t)
+ (make-overlay 10 13 nil nil t)
+ (make-overlay 40 38 nil nil nil)
+ (make-overlay 21 34 nil t t)
+ (make-overlay 55 29 nil nil nil)
+ (make-overlay 36 65 nil t t)
+ (make-overlay 29 12 nil t nil)
+ (make-overlay 41 3 nil nil t)
+ (make-overlay 20 9 nil t t)
+ (make-overlay 52 42 nil t t)
+ (make-overlay 21 56 nil nil t)
+ (make-overlay 25 65 nil nil nil)
+ (make-overlay 38 4 nil t t)
+ (make-overlay 48 23 nil t t)
+ (make-overlay 52 9 nil nil t)
+ (make-overlay 48 19 nil nil nil)
+ (goto-char 43)
+ (delete-char 8)
+ (goto-char 30)
+ (delete-char 16)
+ (goto-char 7)
+ (insert "...")
+ (goto-char 14)
+ (delete-char 5)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 9)
+ (insert "...............")
+ (goto-char 13)
+ (delete-char 17)
+ (goto-char 16)
+ (delete-char 2)
+ (goto-char 9)
+ (insert "")
+ (goto-char 11)
+ (delete-char 5)
+ (goto-char 18)
+ (insert "........")
+ (goto-char 15)
+ (insert "....")
+ (goto-char 16)
+ (delete-char 14)
+ (goto-char 20)
+ (insert ".")
+ (goto-char 25)
+ (delete-char 1)
+ (goto-char 14)
+ (delete-char 14)
+ (goto-char 3)
+ (delete-char 7)
+ (goto-char 3)
+ (delete-char 4)
+ (goto-char 1)
+ (insert "...........")
+ (goto-char 9)
+ (insert ".......")
+ (goto-char 5)
+ (delete-char 7)
+ (goto-char 12)
+ (insert ".........")
+ (goto-char 2)
+ (delete-char 4)
+ (goto-char 3)
+ (widen)
+ (narrow-to-region 14 6)
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 13)
+ (delete-char 8)
+ (goto-char 7)
+ (delete-char 7)
+ (goto-char 7)
+ (insert "..")
+ (goto-char 9)
+ (insert ".............")
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 21)
+ (insert "...............")
+ (goto-char 42)
+ (insert ".........")
+ (should
+ (equal
+ (test-overlay-regions)
+ 'nil))))
+
+(ert-deftest overlay-autogenerated-test-25 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 24 8 nil nil t)
+ (make-overlay 41 16 nil t nil)
+ (make-overlay 3 16 nil nil nil)
+ (make-overlay 26 42 nil nil nil)
+ (make-overlay 32 45 nil nil t)
+ (make-overlay 34 19 nil nil nil)
+ (make-overlay 37 54 nil nil t)
+ (make-overlay 44 34 nil t nil)
+ (make-overlay 49 40 nil t t)
+ (make-overlay 29 34 nil t nil)
+ (make-overlay 54 16 nil t t)
+ (make-overlay 29 4 nil t nil)
+ (make-overlay 44 57 nil nil nil)
+ (make-overlay 5 32 nil nil nil)
+ (make-overlay 12 33 nil nil t)
+ (make-overlay 38 29 nil t nil)
+ (goto-char 12)
+ (delete-char 53)
+ (goto-char 1)
+ (delete-char 6)
+ (goto-char 5)
+ (widen)
+ (narrow-to-region 6 1)
+ (goto-char 6)
+ (insert "......")
+ (goto-char 10)
+ (insert "...............")
+ (goto-char 17)
+ (delete-char 5)
+ (goto-char 7)
+ (insert ".....")
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 4)
+ (insert ".....")
+ (goto-char 44)
+ (widen)
+ (narrow-to-region 18 11)
+ (goto-char 15)
+ (delete-char 1)
+ (goto-char 17)
+ (delete-char 0)
+ (goto-char 13)
+ (delete-char 3)
+ (goto-char 14)
+ (insert "..")
+ (goto-char 16)
+ (insert "..")
+ (goto-char 15)
+ (delete-char 3)
+ (goto-char 13)
+ (delete-char 0)
+ (goto-char 14)
+ (insert "..........")
+ (goto-char 19)
+ (insert ".")
+ (goto-char 23)
+ (delete-char 1)
+ (goto-char 12)
+ (widen)
+ (narrow-to-region 23 40)
+ (goto-char 35)
+ (insert "....")
+ (goto-char 33)
+ (insert "..........")
+ (goto-char 37)
+ (delete-char 16)
+ (goto-char 37)
+ (delete-char 0)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 30 8)
+ (goto-char 29)
+ (delete-char 0)
+ (goto-char 15)
+ (delete-char 15)
+ (goto-char 9)
+ (insert "...........")
+ (goto-char 9)
+ (delete-char 1)
+ (goto-char 22)
+ (delete-char 3)
+ (goto-char 10)
+ (insert ".........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 30)
+ (1 . 30)
+ (1 . 30)
+ (2 . 53)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 30)
+ (30 . 53)
+ (30 . 53)
+ (30 . 53))))))
+
+(ert-deftest overlay-autogenerated-test-26 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 60 59 nil t nil)
+ (make-overlay 18 11 nil nil t)
+ (make-overlay 4 44 nil nil nil)
+ (make-overlay 7 22 nil nil nil)
+ (make-overlay 54 50 nil t nil)
+ (make-overlay 59 28 nil nil nil)
+ (make-overlay 49 23 nil nil t)
+ (make-overlay 21 5 nil t nil)
+ (make-overlay 17 39 nil t nil)
+ (make-overlay 16 14 nil nil nil)
+ (make-overlay 50 26 nil nil nil)
+ (make-overlay 37 14 nil nil nil)
+ (make-overlay 6 59 nil nil t)
+ (make-overlay 30 17 nil nil t)
+ (make-overlay 17 34 nil nil t)
+ (make-overlay 7 22 nil t nil)
+ (goto-char 35)
+ (delete-char 25)
+ (goto-char 30)
+ (delete-char 7)
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 3 19)
+ (goto-char 6)
+ (insert ".........")
+ (goto-char 21)
+ (insert "...............")
+ (goto-char 12)
+ (insert ".............")
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 64 37)
+ (goto-char 62)
+ (insert ".............")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 72 38)
+ (goto-char 66)
+ (insert "")
+ (goto-char 54)
+ (insert "...")
+ (goto-char 70)
+ (delete-char 4)
+ (goto-char 49)
+ (delete-char 13)
+ (goto-char 38)
+ (insert "....")
+ (goto-char 46)
+ (insert ".")
+ (goto-char 43)
+ (widen)
+ (narrow-to-region 74 53)
+ (goto-char 60)
+ (delete-char 10)
+ (goto-char 53)
+ (insert "..............")
+ (goto-char 72)
+ (insert "............")
+ (goto-char 87)
+ (delete-char 2)
+ (goto-char 73)
+ (insert "............")
+ (goto-char 81)
+ (insert "........")
+ (goto-char 106)
+ (insert "...")
+ (goto-char 95)
+ (widen)
+ (narrow-to-region 77 39)
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 40)
+ (insert "...............")
+ (goto-char 101)
+ (insert "")
+ (goto-char 53)
+ (insert "....")
+ (goto-char 79)
+ (delete-char 21)
+ (goto-char 85)
+ (insert "........")
+ (goto-char 52)
+ (delete-char 41)
+ (goto-char 43)
+ (insert ".....")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 90)
+ (5 . 57)
+ (6 . 90)
+ (29 . 57)
+ (29 . 57)
+ (33 . 57))))))
+
+(ert-deftest overlay-autogenerated-test-27 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 20 12 nil t nil)
+ (make-overlay 3 10 nil t t)
+ (make-overlay 11 53 nil t nil)
+ (make-overlay 59 3 nil t nil)
+ (make-overlay 28 19 nil t t)
+ (make-overlay 16 30 nil t t)
+ (make-overlay 39 19 nil t t)
+ (make-overlay 33 50 nil t nil)
+ (make-overlay 36 54 nil nil nil)
+ (make-overlay 42 59 nil nil nil)
+ (make-overlay 30 48 nil t nil)
+ (make-overlay 20 13 nil nil t)
+ (make-overlay 63 48 nil t nil)
+ (make-overlay 48 12 nil t t)
+ (make-overlay 64 50 nil nil nil)
+ (make-overlay 7 7 nil nil nil)
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 21 54)
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 21)
+ (delete-char 2)
+ (goto-char 35)
+ (widen)
+ (narrow-to-region 70 11)
+ (goto-char 45)
+ (insert "...............")
+ (goto-char 74)
+ (insert ".")
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 77 67)
+ (goto-char 72)
+ (insert "..........")
+ (goto-char 85)
+ (delete-char 1)
+ (goto-char 82)
+ (widen)
+ (narrow-to-region 83 86)
+ (goto-char 83)
+ (delete-char 0)
+ (goto-char 86)
+ (delete-char 0)
+ (goto-char 86)
+ (insert "...........")
+ (goto-char 97)
+ (insert ".......")
+ (goto-char 103)
+ (widen)
+ (narrow-to-region 44 68)
+ (goto-char 49)
+ (insert "..")
+ (goto-char 65)
+ (insert ".............")
+ (goto-char 59)
+ (delete-char 0)
+ (goto-char 57)
+ (insert "........")
+ (goto-char 55)
+ (delete-char 30)
+ (goto-char 45)
+ (insert "...............")
+ (goto-char 44)
+ (insert "")
+ (goto-char 62)
+ (insert "............")
+ (goto-char 63)
+ (widen)
+ (narrow-to-region 12 5)
+ (goto-char 8)
+ (delete-char 4)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "..........")
+ (goto-char 15)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "............")
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 13)
+ (insert "..")
+ (goto-char 32)
+ (insert "..............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 55)
+ (3 . 173)
+ (7 . 7))))))
+
+(ert-deftest overlay-autogenerated-test-28 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 59 48 nil t nil)
+ (make-overlay 59 4 nil nil t)
+ (make-overlay 45 35 nil t nil)
+ (make-overlay 13 18 nil t t)
+ (make-overlay 10 7 nil t t)
+ (make-overlay 9 8 nil nil nil)
+ (make-overlay 33 47 nil nil t)
+ (make-overlay 1 57 nil t nil)
+ (make-overlay 16 59 nil nil t)
+ (make-overlay 43 58 nil nil t)
+ (make-overlay 6 11 nil nil nil)
+ (make-overlay 59 7 nil t nil)
+ (make-overlay 3 57 nil t t)
+ (make-overlay 61 35 nil nil nil)
+ (make-overlay 57 8 nil nil nil)
+ (make-overlay 5 32 nil t nil)
+ (goto-char 18)
+ (insert "............")
+ (goto-char 43)
+ (delete-char 2)
+ (goto-char 38)
+ (delete-char 26)
+ (goto-char 42)
+ (insert ".....")
+ (goto-char 52)
+ (insert "..........")
+ (goto-char 45)
+ (delete-char 11)
+ (goto-char 33)
+ (insert "....")
+ (goto-char 23)
+ (delete-char 14)
+ (goto-char 33)
+ (widen)
+ (narrow-to-region 30 33)
+ (goto-char 30)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 30)
+ (delete-char 7)
+ (goto-char 30)
+ (insert ".")
+ (goto-char 32)
+ (delete-char 4)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 46)
+ (insert ".........")
+ (goto-char 45)
+ (delete-char 3)
+ (goto-char 49)
+ (delete-char 2)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 32)
+ (insert "..........")
+ (goto-char 47)
+ (insert "....")
+ (goto-char 59)
+ (insert ".......")
+ (goto-char 35)
+ (insert ".")
+ (goto-char 45)
+ (insert "..............")
+ (goto-char 37)
+ (insert "..")
+ (goto-char 80)
+ (insert ".....")
+ (goto-char 30)
+ (insert ".............")
+ (goto-char 102)
+ (insert "............")
+ (goto-char 113)
+ (insert "")
+ (goto-char 66)
+ (widen)
+ (narrow-to-region 47 38)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 45)
+ (3 . 117)
+ (4 . 121)
+ (7 . 121)
+ (8 . 45)
+ (16 . 121)
+ (28 . 121)
+ (28 . 121)
+ (28 . 121))))))
+
+(ert-deftest overlay-autogenerated-test-29 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 5 63 nil nil t)
+ (make-overlay 20 28 nil t t)
+ (make-overlay 58 53 nil t nil)
+ (make-overlay 4 57 nil t t)
+ (make-overlay 4 16 nil nil nil)
+ (make-overlay 33 26 nil t nil)
+ (make-overlay 9 32 nil t t)
+ (make-overlay 11 8 nil nil nil)
+ (make-overlay 59 35 nil nil t)
+ (make-overlay 15 25 nil t t)
+ (make-overlay 36 16 nil nil nil)
+ (make-overlay 8 37 nil nil nil)
+ (make-overlay 65 63 nil nil t)
+ (make-overlay 3 20 nil nil t)
+ (make-overlay 44 55 nil t t)
+ (make-overlay 45 25 nil t nil)
+ (goto-char 39)
+ (insert "...")
+ (goto-char 22)
+ (insert "........")
+ (goto-char 60)
+ (insert ".........")
+ (goto-char 17)
+ (insert "............")
+ (goto-char 13)
+ (widen)
+ (narrow-to-region 79 16)
+ (goto-char 19)
+ (delete-char 11)
+ (goto-char 25)
+ (insert "........")
+ (goto-char 61)
+ (insert "....")
+ (goto-char 45)
+ (widen)
+ (narrow-to-region 73 66)
+ (goto-char 71)
+ (insert "............")
+ (goto-char 81)
+ (delete-char 2)
+ (goto-char 73)
+ (insert "..........")
+ (goto-char 74)
+ (insert "............")
+ (goto-char 82)
+ (delete-char 7)
+ (goto-char 78)
+ (delete-char 18)
+ (goto-char 75)
+ (insert ".........")
+ (goto-char 66)
+ (insert ".........")
+ (goto-char 86)
+ (delete-char 12)
+ (goto-char 77)
+ (widen)
+ (narrow-to-region 23 55)
+ (goto-char 43)
+ (insert ".")
+ (goto-char 50)
+ (insert "..")
+ (goto-char 25)
+ (delete-char 18)
+ (goto-char 33)
+ (delete-char 7)
+ (goto-char 26)
+ (insert "........")
+ (goto-char 29)
+ (insert "...........")
+ (goto-char 33)
+ (insert "...")
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 26)
+ (insert "")
+ (goto-char 35)
+ (insert ".")
+ (goto-char 59)
+ (insert ".")
+ (goto-char 51)
+ (insert "..")
+ (goto-char 59)
+ (insert ".............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 130)
+ (5 . 136)
+ (8 . 82)
+ (9 . 82)
+ (15 . 25)
+ (16 . 82)
+ (21 . 77)
+ (25 . 105)
+ (75 . 82))))))
+
+(ert-deftest overlay-autogenerated-test-30 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 27 65 nil t t)
+ (make-overlay 39 51 nil t t)
+ (make-overlay 53 2 nil nil nil)
+ (make-overlay 3 17 nil nil t)
+ (make-overlay 35 4 nil nil t)
+ (make-overlay 65 53 nil t nil)
+ (make-overlay 8 21 nil t t)
+ (make-overlay 18 62 nil t t)
+ (make-overlay 42 59 nil nil t)
+ (make-overlay 12 37 nil t t)
+ (make-overlay 64 31 nil t nil)
+ (make-overlay 39 54 nil nil t)
+ (make-overlay 41 24 nil t nil)
+ (make-overlay 10 21 nil nil t)
+ (make-overlay 49 15 nil t nil)
+ (make-overlay 49 63 nil nil t)
+ (goto-char 43)
+ (insert "..........")
+ (goto-char 44)
+ (delete-char 29)
+ (goto-char 32)
+ (insert "..")
+ (goto-char 13)
+ (insert ".")
+ (goto-char 42)
+ (insert ".........")
+ (goto-char 39)
+ (insert "..........")
+ (goto-char 15)
+ (insert "............")
+ (goto-char 58)
+ (delete-char 9)
+ (goto-char 63)
+ (insert ".........")
+ (goto-char 49)
+ (insert ".")
+ (goto-char 28)
+ (delete-char 51)
+ (goto-char 12)
+ (delete-char 6)
+ (goto-char 20)
+ (delete-char 2)
+ (goto-char 7)
+ (widen)
+ (narrow-to-region 2 9)
+ (goto-char 5)
+ (insert "...............")
+ (goto-char 18)
+ (delete-char 1)
+ (goto-char 4)
+ (insert ".............")
+ (goto-char 13)
+ (delete-char 22)
+ (goto-char 12)
+ (insert "")
+ (goto-char 3)
+ (insert ".............")
+ (goto-char 22)
+ (insert "...............")
+ (goto-char 9)
+ (insert "....")
+ (goto-char 8)
+ (insert "...........")
+ (goto-char 6)
+ (delete-char 34)
+ (goto-char 21)
+ (insert "....")
+ (goto-char 14)
+ (insert ".....")
+ (goto-char 20)
+ (insert ".......")
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 3 2)
+ (goto-char 3)
+ (delete-char 0)
+ (goto-char 2)
+ (insert "..............")
+ (goto-char 15)
+ (delete-char 2)
+ (goto-char 11)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 68))))))
+
+(ert-deftest overlay-autogenerated-test-31 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 54 64 nil nil nil)
+ (make-overlay 49 12 nil nil t)
+ (make-overlay 40 12 nil t nil)
+ (make-overlay 17 38 nil nil nil)
+ (make-overlay 21 36 nil t t)
+ (make-overlay 8 38 nil t nil)
+ (make-overlay 50 22 nil t nil)
+ (make-overlay 65 15 nil nil t)
+ (make-overlay 57 60 nil t t)
+ (make-overlay 35 11 nil nil t)
+ (make-overlay 49 44 nil nil t)
+ (make-overlay 45 31 nil nil t)
+ (make-overlay 51 24 nil t t)
+ (make-overlay 20 14 nil nil nil)
+ (make-overlay 6 18 nil t t)
+ (make-overlay 25 3 nil nil nil)
+ (goto-char 18)
+ (delete-char 10)
+ (goto-char 36)
+ (delete-char 13)
+ (goto-char 8)
+ (delete-char 4)
+ (goto-char 2)
+ (delete-char 8)
+ (goto-char 12)
+ (delete-char 10)
+ (goto-char 15)
+ (delete-char 4)
+ (goto-char 16)
+ (insert ".........")
+ (goto-char 17)
+ (insert "...............")
+ (goto-char 33)
+ (delete-char 0)
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 11)
+ (insert "...........")
+ (goto-char 8)
+ (delete-char 14)
+ (goto-char 32)
+ (insert "........")
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 14 6)
+ (goto-char 10)
+ (delete-char 1)
+ (goto-char 7)
+ (widen)
+ (narrow-to-region 18 39)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 39 14)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 25 21)
+ (goto-char 23)
+ (delete-char 2)
+ (goto-char 23)
+ (delete-char 0)
+ (goto-char 23)
+ (insert ".........")
+ (goto-char 32)
+ (delete-char 0)
+ (goto-char 31)
+ (insert ".........")
+ (goto-char 32)
+ (insert "...")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 10 56)
+ (goto-char 10)
+ (insert ".........")
+ (goto-char 38)
+ (insert ".........")
+ (goto-char 19)
+ (insert "..")
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 66)
+ (insert "...............")
+ (goto-char 13)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 41)
+ (3 . 117)
+ (6 . 41)
+ (8 . 41)
+ (9 . 41)
+ (10 . 42)
+ (41 . 42))))))
+
+(ert-deftest overlay-autogenerated-test-32 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 35 60 nil nil t)
+ (make-overlay 45 46 nil nil nil)
+ (make-overlay 47 11 nil nil t)
+ (make-overlay 12 51 nil t nil)
+ (make-overlay 61 17 nil t nil)
+ (make-overlay 7 24 nil t nil)
+ (make-overlay 36 37 nil nil t)
+ (make-overlay 5 39 nil t t)
+ (make-overlay 5 40 nil nil t)
+ (make-overlay 38 40 nil t t)
+ (make-overlay 47 45 nil t nil)
+ (make-overlay 61 48 nil nil nil)
+ (make-overlay 23 39 nil t t)
+ (make-overlay 11 52 nil nil nil)
+ (make-overlay 37 35 nil nil nil)
+ (make-overlay 19 20 nil t nil)
+ (goto-char 43)
+ (insert "........")
+ (goto-char 7)
+ (insert "")
+ (goto-char 28)
+ (delete-char 41)
+ (goto-char 3)
+ (delete-char 17)
+ (goto-char 2)
+ (insert ".")
+ (goto-char 7)
+ (insert ".........")
+ (goto-char 21)
+ (delete-char 4)
+ (goto-char 13)
+ (delete-char 1)
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 7)
+ (insert "")
+ (goto-char 14)
+ (insert ".....")
+ (goto-char 16)
+ (insert ".")
+ (goto-char 10)
+ (insert "..............")
+ (goto-char 16)
+ (delete-char 18)
+ (goto-char 1)
+ (delete-char 36)
+ (goto-char 1)
+ (delete-char 0)
+ (goto-char 1)
+ (delete-char 0)
+ (goto-char 1)
+ (insert ".............")
+ (goto-char 9)
+ (insert ".")
+ (goto-char 14)
+ (insert ".....")
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 15)
+ (delete-char 0)
+ (goto-char 6)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 5)
+ (goto-char 5)
+ (insert "....")
+ (goto-char 5)
+ (insert ".....")
+ (goto-char 12)
+ (insert "")
+ (goto-char 13)
+ (insert ".......")
+ (goto-char 14)
+ (insert "......")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 17)
+ (delete-char 0)
+ (goto-char 7)
+ (delete-char 12)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 18)
+ (1 . 18)
+ (1 . 18)
+ (1 . 18)
+ (18 . 18)
+ (18 . 18)
+ (18 . 18))))))
+
+(ert-deftest overlay-autogenerated-test-33 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 65 33 nil t nil)
+ (make-overlay 45 54 nil t t)
+ (make-overlay 17 38 nil t nil)
+ (make-overlay 58 46 nil nil t)
+ (make-overlay 21 36 nil t t)
+ (make-overlay 31 63 nil nil t)
+ (make-overlay 37 64 nil t t)
+ (make-overlay 42 19 nil nil nil)
+ (make-overlay 51 60 nil t nil)
+ (make-overlay 47 15 nil t t)
+ (make-overlay 57 47 nil nil nil)
+ (make-overlay 40 45 nil nil nil)
+ (make-overlay 44 47 nil t nil)
+ (make-overlay 42 35 nil t nil)
+ (make-overlay 1 65 nil nil t)
+ (make-overlay 29 63 nil t nil)
+ (goto-char 33)
+ (insert "...........")
+ (goto-char 56)
+ (insert ".........")
+ (goto-char 67)
+ (insert "....")
+ (goto-char 28)
+ (delete-char 35)
+ (goto-char 9)
+ (insert "......")
+ (goto-char 43)
+ (delete-char 17)
+ (goto-char 29)
+ (insert ".......")
+ (goto-char 20)
+ (insert "....")
+ (goto-char 53)
+ (insert ".......")
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 38 57)
+ (goto-char 51)
+ (insert "")
+ (goto-char 57)
+ (insert ".......")
+ (goto-char 64)
+ (insert ".....")
+ (goto-char 59)
+ (delete-char 3)
+ (goto-char 45)
+ (delete-char 12)
+ (goto-char 43)
+ (insert "......")
+ (goto-char 48)
+ (insert "......")
+ (goto-char 52)
+ (insert "........")
+ (goto-char 57)
+ (delete-char 16)
+ (goto-char 43)
+ (delete-char 9)
+ (goto-char 40)
+ (insert "")
+ (goto-char 39)
+ (insert "..........")
+ (goto-char 50)
+ (widen)
+ (narrow-to-region 31 27)
+ (goto-char 27)
+ (insert "..........")
+ (goto-char 33)
+ (delete-char 0)
+ (goto-char 37)
+ (insert "..")
+ (goto-char 38)
+ (delete-char 4)
+ (goto-char 38)
+ (insert "..........")
+ (goto-char 45)
+ (insert ".....")
+ (goto-char 53)
+ (insert "...")
+ (goto-char 51)
+ (insert ".")
+ (goto-char 28)
+ (insert "...")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 93)
+ (25 . 92)
+ (41 . 88)
+ (60 . 88))))))
+
+(ert-deftest overlay-autogenerated-test-34 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 2 63 nil nil t)
+ (make-overlay 54 30 nil t nil)
+ (make-overlay 21 57 nil t nil)
+ (make-overlay 61 19 nil nil nil)
+ (make-overlay 55 8 nil nil t)
+ (make-overlay 14 51 nil nil nil)
+ (make-overlay 33 13 nil t t)
+ (make-overlay 36 25 nil t t)
+ (make-overlay 22 21 nil nil t)
+ (make-overlay 21 48 nil nil t)
+ (make-overlay 36 7 nil nil t)
+ (make-overlay 2 40 nil nil nil)
+ (make-overlay 21 27 nil nil t)
+ (make-overlay 26 2 nil nil nil)
+ (make-overlay 60 43 nil nil nil)
+ (make-overlay 12 50 nil t t)
+ (goto-char 44)
+ (delete-char 6)
+ (goto-char 5)
+ (insert "..")
+ (goto-char 17)
+ (insert "........")
+ (goto-char 48)
+ (insert "..")
+ (goto-char 27)
+ (delete-char 29)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 35)
+ (insert ".............")
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 6)
+ (insert ".")
+ (goto-char 9)
+ (delete-char 6)
+ (goto-char 38)
+ (insert ".........")
+ (goto-char 5)
+ (insert ".........")
+ (goto-char 10)
+ (delete-char 20)
+ (goto-char 6)
+ (delete-char 6)
+ (goto-char 14)
+ (insert ".............")
+ (goto-char 31)
+ (delete-char 10)
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 27 39)
+ (goto-char 34)
+ (delete-char 5)
+ (goto-char 32)
+ (delete-char 1)
+ (goto-char 27)
+ (insert "..")
+ (goto-char 28)
+ (insert "........")
+ (goto-char 39)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 7)
+ (goto-char 44)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "...............")
+ (goto-char 43)
+ (insert "............")
+ (goto-char 56)
+ (delete-char 1)
+ (goto-char 65)
+ (delete-char 3)
+ (goto-char 36)
+ (insert ".........")
+ (goto-char 74)
+ (insert ".....")
+ (goto-char 67)
+ (delete-char 5)
+ (goto-char 38)
+ (insert "..")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 80)
+ (6 . 78))))))
+
+(ert-deftest overlay-autogenerated-test-35 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 38 16 nil nil nil)
+ (make-overlay 19 22 nil t nil)
+ (make-overlay 16 43 nil nil t)
+ (make-overlay 27 5 nil nil nil)
+ (make-overlay 43 34 nil t nil)
+ (make-overlay 47 4 nil nil t)
+ (make-overlay 1 47 nil nil t)
+ (make-overlay 27 35 nil t nil)
+ (make-overlay 41 41 nil nil t)
+ (make-overlay 21 19 nil nil nil)
+ (make-overlay 16 38 nil nil t)
+ (make-overlay 33 39 nil t nil)
+ (make-overlay 34 51 nil nil t)
+ (make-overlay 45 36 nil t nil)
+ (make-overlay 42 18 nil t t)
+ (make-overlay 12 30 nil nil nil)
+ (goto-char 18)
+ (insert "")
+ (goto-char 58)
+ (delete-char 3)
+ (goto-char 58)
+ (delete-char 0)
+ (goto-char 1)
+ (insert ".......")
+ (goto-char 48)
+ (delete-char 17)
+ (goto-char 39)
+ (delete-char 6)
+ (goto-char 33)
+ (widen)
+ (narrow-to-region 45 46)
+ (goto-char 46)
+ (insert "")
+ (goto-char 46)
+ (delete-char 0)
+ (goto-char 46)
+ (insert ".....")
+ (goto-char 51)
+ (widen)
+ (narrow-to-region 17 26)
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 50 41)
+ (goto-char 45)
+ (insert "..............")
+ (goto-char 59)
+ (insert "...........")
+ (goto-char 47)
+ (delete-char 9)
+ (goto-char 59)
+ (insert "")
+ (goto-char 46)
+ (insert "")
+ (goto-char 54)
+ (delete-char 5)
+ (goto-char 57)
+ (widen)
+ (narrow-to-region 57 31)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 52)
+ (insert "....")
+ (goto-char 44)
+ (insert "..")
+ (goto-char 44)
+ (insert "...............")
+ (goto-char 72)
+ (delete-char 1)
+ (goto-char 66)
+ (delete-char 6)
+ (goto-char 64)
+ (delete-char 5)
+ (goto-char 49)
+ (delete-char 12)
+ (goto-char 32)
+ (insert "......")
+ (goto-char 44)
+ (delete-char 2)
+ (goto-char 39)
+ (delete-char 12)
+ (goto-char 42)
+ (insert "......")
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 14 47)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 39)
+ (11 . 39)
+ (12 . 39)
+ (19 . 39)
+ (23 . 39)
+ (23 . 39)
+ (23 . 39)
+ (25 . 39)
+ (26 . 28)
+ (26 . 29)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39)
+ (39 . 39))))))
+
+(ert-deftest overlay-autogenerated-test-36 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 1 38 nil t t)
+ (make-overlay 58 34 nil t nil)
+ (make-overlay 6 33 nil nil t)
+ (make-overlay 63 54 nil nil t)
+ (make-overlay 54 54 nil t t)
+ (make-overlay 21 61 nil nil nil)
+ (make-overlay 64 55 nil nil t)
+ (make-overlay 28 65 nil nil t)
+ (make-overlay 32 51 nil t nil)
+ (make-overlay 36 38 nil nil nil)
+ (make-overlay 35 21 nil nil nil)
+ (make-overlay 65 48 nil nil nil)
+ (make-overlay 32 27 nil nil t)
+ (make-overlay 27 55 nil t t)
+ (make-overlay 30 22 nil t nil)
+ (make-overlay 14 58 nil t nil)
+ (goto-char 40)
+ (delete-char 7)
+ (goto-char 42)
+ (insert "......")
+ (goto-char 11)
+ (widen)
+ (narrow-to-region 64 9)
+ (goto-char 21)
+ (delete-char 23)
+ (goto-char 24)
+ (insert "...")
+ (goto-char 13)
+ (insert "..........")
+ (goto-char 12)
+ (delete-char 5)
+ (goto-char 10)
+ (delete-char 0)
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 9 5)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "............")
+ (goto-char 9)
+ (insert "...")
+ (goto-char 18)
+ (insert ".")
+ (goto-char 23)
+ (delete-char 1)
+ (goto-char 9)
+ (insert "....")
+ (goto-char 6)
+ (insert ".....")
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 28 1)
+ (goto-char 6)
+ (insert "...........")
+ (goto-char 30)
+ (delete-char 8)
+ (goto-char 2)
+ (insert ".")
+ (goto-char 18)
+ (insert "......")
+ (goto-char 5)
+ (delete-char 9)
+ (goto-char 5)
+ (delete-char 20)
+ (goto-char 4)
+ (delete-char 3)
+ (goto-char 3)
+ (delete-char 2)
+ (goto-char 3)
+ (delete-char 0)
+ (goto-char 1)
+ (insert "......")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 39 2)
+ (goto-char 13)
+ (delete-char 12)
+ (goto-char 24)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((7 . 20)
+ (9 . 20)
+ (13 . 36)
+ (20 . 20)
+ (20 . 20)
+ (20 . 20)
+ (20 . 20)
+ (20 . 29)
+ (20 . 33)
+ (20 . 36)
+ (20 . 39)
+ (20 . 43)
+ (20 . 43))))))
+
+(ert-deftest overlay-autogenerated-test-37 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 26 30 nil nil nil)
+ (make-overlay 55 50 nil nil t)
+ (make-overlay 43 54 nil nil t)
+ (make-overlay 53 48 nil nil nil)
+ (make-overlay 37 51 nil nil t)
+ (make-overlay 15 30 nil nil nil)
+ (make-overlay 2 24 nil t t)
+ (make-overlay 56 61 nil t nil)
+ (make-overlay 65 46 nil t nil)
+ (make-overlay 28 47 nil t nil)
+ (make-overlay 21 24 nil t t)
+ (make-overlay 17 13 nil t t)
+ (make-overlay 7 44 nil t nil)
+ (make-overlay 28 63 nil nil nil)
+ (make-overlay 22 16 nil t t)
+ (make-overlay 26 44 nil t t)
+ (goto-char 57)
+ (delete-char 6)
+ (goto-char 42)
+ (insert ".....")
+ (goto-char 63)
+ (insert ".............")
+ (goto-char 17)
+ (insert "")
+ (goto-char 57)
+ (insert "...........")
+ (goto-char 3)
+ (delete-char 47)
+ (goto-char 15)
+ (insert ".............")
+ (goto-char 28)
+ (insert "")
+ (goto-char 17)
+ (delete-char 31)
+ (goto-char 7)
+ (delete-char 16)
+ (goto-char 2)
+ (insert "...........")
+ (goto-char 2)
+ (insert "..")
+ (goto-char 18)
+ (widen)
+ (narrow-to-region 20 8)
+ (goto-char 13)
+ (widen)
+ (narrow-to-region 12 10)
+ (goto-char 10)
+ (delete-char 1)
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 10)
+ (insert "...")
+ (goto-char 11)
+ (delete-char 0)
+ (goto-char 13)
+ (insert "..")
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 11)
+ (insert ".....")
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 6 13)
+ (goto-char 10)
+ (insert "..")
+ (goto-char 6)
+ (delete-char 6)
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 21)
+ (delete-char 0)
+ (goto-char 21)
+ (widen)
+ (narrow-to-region 36 11)
+ (goto-char 12)
+ (insert "...............")
+ (goto-char 19)
+ (insert ".......")
+ (goto-char 56)
+ (delete-char 2)
+ (goto-char 42)
+ (delete-char 11)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((44 . 45))))))
+
+(ert-deftest overlay-autogenerated-test-38 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 29 13 nil t t)
+ (make-overlay 19 28 nil nil t)
+ (make-overlay 47 33 nil nil nil)
+ (make-overlay 8 44 nil t nil)
+ (make-overlay 48 4 nil t nil)
+ (make-overlay 8 20 nil t t)
+ (make-overlay 38 31 nil nil t)
+ (make-overlay 17 65 nil nil t)
+ (make-overlay 49 31 nil nil nil)
+ (make-overlay 39 19 nil nil t)
+ (make-overlay 40 49 nil t t)
+ (make-overlay 24 16 nil t t)
+ (make-overlay 4 41 nil t nil)
+ (make-overlay 61 42 nil t nil)
+ (make-overlay 46 11 nil nil nil)
+ (make-overlay 1 43 nil nil t)
+ (goto-char 62)
+ (delete-char 2)
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 30 38)
+ (goto-char 37)
+ (delete-char 1)
+ (goto-char 37)
+ (insert "...........")
+ (goto-char 41)
+ (delete-char 3)
+ (goto-char 39)
+ (delete-char 5)
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 31 9)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 9)
+ (widen)
+ (narrow-to-region 62 30)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 17 48)
+ (goto-char 39)
+ (delete-char 7)
+ (goto-char 24)
+ (delete-char 8)
+ (goto-char 19)
+ (insert "")
+ (goto-char 25)
+ (delete-char 5)
+ (goto-char 28)
+ (delete-char 0)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 52 35)
+ (goto-char 49)
+ (delete-char 0)
+ (goto-char 49)
+ (delete-char 3)
+ (goto-char 48)
+ (insert "...........")
+ (goto-char 37)
+ (delete-char 23)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 35)
+ (insert "....")
+ (goto-char 35)
+ (insert "..")
+ (goto-char 39)
+ (delete-char 4)
+ (goto-char 39)
+ (delete-char 0)
+ (goto-char 36)
+ (delete-char 3)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 36)
+ (delete-char 0)
+ (goto-char 36)
+ (insert ".....")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 35)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 37)
+ (24 . 44)
+ (25 . 37))))))
+
+(ert-deftest overlay-autogenerated-test-39 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 15 49 nil t t)
+ (make-overlay 27 20 nil t nil)
+ (make-overlay 55 50 nil t nil)
+ (make-overlay 17 5 nil t t)
+ (make-overlay 26 56 nil nil t)
+ (make-overlay 42 11 nil t t)
+ (make-overlay 24 35 nil nil t)
+ (make-overlay 47 45 nil t t)
+ (make-overlay 37 12 nil nil t)
+ (make-overlay 17 25 nil t nil)
+ (make-overlay 32 53 nil nil nil)
+ (make-overlay 20 34 nil nil t)
+ (make-overlay 56 58 nil nil t)
+ (make-overlay 42 31 nil nil t)
+ (make-overlay 22 55 nil t t)
+ (make-overlay 55 11 nil t nil)
+ (goto-char 16)
+ (insert ".............")
+ (goto-char 30)
+ (insert ".")
+ (goto-char 12)
+ (delete-char 56)
+ (goto-char 9)
+ (insert ".............")
+ (goto-char 6)
+ (insert "....")
+ (goto-char 19)
+ (delete-char 19)
+ (goto-char 19)
+ (insert "...............")
+ (goto-char 13)
+ (delete-char 21)
+ (goto-char 7)
+ (delete-char 0)
+ (goto-char 14)
+ (widen)
+ (narrow-to-region 5 6)
+ (goto-char 5)
+ (delete-char 0)
+ (goto-char 6)
+ (insert "......")
+ (goto-char 10)
+ (delete-char 0)
+ (goto-char 7)
+ (widen)
+ (narrow-to-region 2 6)
+ (goto-char 2)
+ (insert "..........")
+ (goto-char 2)
+ (delete-char 9)
+ (goto-char 7)
+ (insert "...")
+ (goto-char 9)
+ (insert "...")
+ (goto-char 10)
+ (insert "......")
+ (goto-char 4)
+ (delete-char 14)
+ (goto-char 4)
+ (insert ".")
+ (goto-char 5)
+ (insert "..............")
+ (goto-char 13)
+ (insert "......")
+ (goto-char 10)
+ (insert "......")
+ (goto-char 20)
+ (insert "............")
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 3 32)
+ (goto-char 18)
+ (insert "..")
+ (goto-char 6)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 31)
+ (insert "............")
+ (goto-char 28)
+ (insert "")
+ (goto-char 9)
+ (delete-char 23)
+ (should
+ (equal
+ (test-overlay-regions)
+ 'nil))))
+
+(ert-deftest overlay-autogenerated-test-40 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 52 3 nil t nil)
+ (make-overlay 35 41 nil t t)
+ (make-overlay 4 2 nil t nil)
+ (make-overlay 51 48 nil nil t)
+ (make-overlay 44 57 nil t t)
+ (make-overlay 13 32 nil nil nil)
+ (make-overlay 46 29 nil t nil)
+ (make-overlay 28 13 nil t nil)
+ (make-overlay 10 65 nil t t)
+ (make-overlay 41 48 nil nil t)
+ (make-overlay 36 44 nil nil t)
+ (make-overlay 29 61 nil t nil)
+ (make-overlay 25 24 nil nil t)
+ (make-overlay 22 45 nil nil t)
+ (make-overlay 37 55 nil nil t)
+ (make-overlay 36 39 nil nil nil)
+ (goto-char 16)
+ (delete-char 48)
+ (goto-char 17)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "..............")
+ (goto-char 30)
+ (insert "........")
+ (goto-char 11)
+ (insert "..........")
+ (goto-char 5)
+ (delete-char 14)
+ (goto-char 19)
+ (insert ".")
+ (goto-char 27)
+ (insert "..")
+ (goto-char 35)
+ (delete-char 1)
+ (goto-char 29)
+ (delete-char 0)
+ (goto-char 33)
+ (delete-char 2)
+ (goto-char 33)
+ (insert "..")
+ (goto-char 28)
+ (insert ".........")
+ (goto-char 30)
+ (delete-char 4)
+ (goto-char 40)
+ (delete-char 1)
+ (goto-char 15)
+ (widen)
+ (narrow-to-region 40 8)
+ (goto-char 10)
+ (delete-char 13)
+ (goto-char 11)
+ (delete-char 5)
+ (goto-char 15)
+ (insert "........")
+ (goto-char 26)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 1)
+ (goto-char 14)
+ (insert "............")
+ (goto-char 33)
+ (insert ".")
+ (goto-char 10)
+ (insert "...")
+ (goto-char 30)
+ (widen)
+ (narrow-to-region 28 9)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 27)
+ (delete-char 1)
+ (goto-char 26)
+ (insert "..")
+ (goto-char 27)
+ (insert "..")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 12)
+ (widen)
+ (narrow-to-region 40 30)
+ (goto-char 37)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((13 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (14 . 37)
+ (37 . 37)
+ (37 . 37))))))
+
+(ert-deftest overlay-autogenerated-test-41 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 28 48 nil nil t)
+ (make-overlay 30 11 nil nil t)
+ (make-overlay 7 12 nil t nil)
+ (make-overlay 65 35 nil t nil)
+ (make-overlay 22 61 nil t nil)
+ (make-overlay 37 42 nil nil nil)
+ (make-overlay 33 38 nil nil t)
+ (make-overlay 48 45 nil t t)
+ (make-overlay 45 62 nil t nil)
+ (make-overlay 63 7 nil nil t)
+ (make-overlay 23 42 nil t nil)
+ (make-overlay 21 4 nil t nil)
+ (make-overlay 64 41 nil t nil)
+ (make-overlay 20 33 nil t t)
+ (make-overlay 41 26 nil t nil)
+ (make-overlay 43 31 nil t t)
+ (goto-char 55)
+ (delete-char 3)
+ (goto-char 12)
+ (insert "..")
+ (goto-char 62)
+ (insert "")
+ (goto-char 24)
+ (delete-char 2)
+ (goto-char 41)
+ (insert "............")
+ (goto-char 2)
+ (insert ".")
+ (goto-char 55)
+ (insert "........")
+ (goto-char 67)
+ (delete-char 6)
+ (goto-char 58)
+ (delete-char 10)
+ (goto-char 29)
+ (insert "")
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 44 45)
+ (goto-char 44)
+ (delete-char 1)
+ (goto-char 44)
+ (widen)
+ (narrow-to-region 24 37)
+ (goto-char 30)
+ (delete-char 7)
+ (goto-char 27)
+ (insert "......")
+ (goto-char 35)
+ (delete-char 0)
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 37)
+ (delete-char 9)
+ (goto-char 40)
+ (insert "..........")
+ (goto-char 35)
+ (insert "......")
+ (goto-char 25)
+ (delete-char 7)
+ (goto-char 40)
+ (delete-char 4)
+ (goto-char 25)
+ (delete-char 14)
+ (goto-char 28)
+ (insert "")
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 17 43)
+ (goto-char 20)
+ (insert "..........")
+ (goto-char 22)
+ (delete-char 2)
+ (goto-char 48)
+ (insert "............")
+ (goto-char 47)
+ (insert ".........")
+ (goto-char 69)
+ (widen)
+ (narrow-to-region 52 25)
+ (goto-char 26)
+ (insert "......")
+ (goto-char 53)
+ (insert "..")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 38)
+ (8 . 97)
+ (12 . 47)
+ (37 . 47)
+ (39 . 52)
+ (39 . 87)
+ (39 . 95)
+ (46 . 90)
+ (47 . 49)
+ (47 . 90)
+ (47 . 99)
+ (48 . 87))))))
+
+(ert-deftest overlay-autogenerated-test-42 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 20 23 nil nil nil)
+ (make-overlay 45 51 nil t nil)
+ (make-overlay 34 58 nil t nil)
+ (make-overlay 27 11 nil nil nil)
+ (make-overlay 14 8 nil t t)
+ (make-overlay 64 43 nil t nil)
+ (make-overlay 61 56 nil nil t)
+ (make-overlay 28 14 nil t nil)
+ (make-overlay 21 46 nil t t)
+ (make-overlay 30 34 nil t t)
+ (make-overlay 47 40 nil nil nil)
+ (make-overlay 5 44 nil t t)
+ (make-overlay 11 45 nil nil nil)
+ (make-overlay 65 8 nil nil t)
+ (make-overlay 47 54 nil t t)
+ (make-overlay 37 57 nil t nil)
+ (goto-char 11)
+ (insert "....")
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 56)
+ (delete-char 4)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 23)
+ (insert ".............")
+ (goto-char 2)
+ (insert "............")
+ (goto-char 84)
+ (delete-char 1)
+ (goto-char 10)
+ (insert "..............")
+ (goto-char 19)
+ (insert "............")
+ (goto-char 69)
+ (delete-char 6)
+ (goto-char 15)
+ (insert "........")
+ (goto-char 104)
+ (insert "")
+ (goto-char 94)
+ (delete-char 11)
+ (goto-char 66)
+ (insert ".....")
+ (goto-char 67)
+ (insert "")
+ (goto-char 53)
+ (delete-char 22)
+ (goto-char 42)
+ (insert ".")
+ (goto-char 38)
+ (delete-char 13)
+ (goto-char 27)
+ (insert "......")
+ (goto-char 16)
+ (insert "............")
+ (goto-char 71)
+ (widen)
+ (narrow-to-region 59 15)
+ (goto-char 46)
+ (insert "..")
+ (goto-char 20)
+ (widen)
+ (narrow-to-region 95 93)
+ (goto-char 94)
+ (insert ".............")
+ (goto-char 103)
+ (widen)
+ (narrow-to-region 97 7)
+ (goto-char 93)
+ (insert "....")
+ (goto-char 85)
+ (insert "...........")
+ (goto-char 69)
+ (delete-char 24)
+ (goto-char 87)
+ (insert ".............")
+ (goto-char 7)
+ (delete-char 28)
+ (goto-char 65)
+ (delete-char 8)
+ (goto-char 48)
+ (insert "......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((31 . 44)
+ (33 . 33)
+ (33 . 41)
+ (33 . 41)
+ (33 . 41)
+ (33 . 41)
+ (33 . 82)
+ (40 . 44)
+ (41 . 41)
+ (41 . 41)
+ (41 . 47)
+ (41 . 48)
+ (44 . 45)
+ (44 . 46)
+ (44 . 63)
+ (46 . 57))))))
+
+(ert-deftest overlay-autogenerated-test-43 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 8 53 nil t nil)
+ (make-overlay 11 50 nil t nil)
+ (make-overlay 1 30 nil nil nil)
+ (make-overlay 54 15 nil t t)
+ (make-overlay 22 30 nil nil nil)
+ (make-overlay 1 33 nil nil nil)
+ (make-overlay 18 15 nil t nil)
+ (make-overlay 43 39 nil nil t)
+ (make-overlay 43 17 nil t nil)
+ (make-overlay 2 29 nil t nil)
+ (make-overlay 57 42 nil t nil)
+ (make-overlay 40 1 nil nil nil)
+ (make-overlay 8 64 nil nil nil)
+ (make-overlay 64 15 nil nil nil)
+ (make-overlay 9 11 nil nil t)
+ (make-overlay 40 21 nil t nil)
+ (goto-char 5)
+ (delete-char 37)
+ (goto-char 25)
+ (delete-char 2)
+ (goto-char 17)
+ (insert "...........")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 20 20)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 20)
+ (insert "..........")
+ (goto-char 24)
+ (delete-char 5)
+ (goto-char 24)
+ (insert "...")
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 20 36)
+ (goto-char 26)
+ (delete-char 2)
+ (goto-char 31)
+ (insert ".............")
+ (goto-char 22)
+ (insert ".....")
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 31)
+ (delete-char 4)
+ (goto-char 27)
+ (insert "...")
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 37 20)
+ (goto-char 22)
+ (insert ".............")
+ (goto-char 33)
+ (insert "......")
+ (goto-char 43)
+ (insert "............")
+ (goto-char 59)
+ (insert ".......")
+ (goto-char 25)
+ (delete-char 26)
+ (goto-char 49)
+ (insert ".........")
+ (goto-char 50)
+ (insert ".......")
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 54 86)
+ (goto-char 64)
+ (insert "...............")
+ (goto-char 83)
+ (insert "............")
+ (goto-char 70)
+ (insert "........")
+ (goto-char 58)
+ (insert "..............")
+ (goto-char 83)
+ (insert "............")
+ (goto-char 83)
+ (insert "..........")
+ (goto-char 69)
+ (delete-char 75)
+ (goto-char 75)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 75)
+ (5 . 75)
+ (5 . 80)
+ (5 . 80))))))
+
+(ert-deftest overlay-autogenerated-test-44 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 8 48 nil nil t)
+ (make-overlay 52 38 nil nil nil)
+ (make-overlay 3 63 nil nil nil)
+ (make-overlay 44 15 nil nil t)
+ (make-overlay 27 44 nil nil t)
+ (make-overlay 43 9 nil nil t)
+ (make-overlay 11 27 nil t nil)
+ (make-overlay 36 41 nil nil t)
+ (make-overlay 23 25 nil t t)
+ (make-overlay 19 60 nil t t)
+ (make-overlay 11 55 nil t nil)
+ (make-overlay 59 2 nil t nil)
+ (make-overlay 32 64 nil t nil)
+ (make-overlay 15 8 nil nil nil)
+ (make-overlay 61 15 nil nil nil)
+ (make-overlay 64 30 nil t t)
+ (goto-char 42)
+ (delete-char 20)
+ (goto-char 44)
+ (delete-char 1)
+ (goto-char 43)
+ (insert "...........")
+ (goto-char 43)
+ (delete-char 1)
+ (goto-char 28)
+ (delete-char 8)
+ (goto-char 37)
+ (delete-char 9)
+ (goto-char 4)
+ (delete-char 30)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 7)
+ (delete-char 0)
+ (goto-char 2)
+ (delete-char 2)
+ (goto-char 5)
+ (delete-char 0)
+ (goto-char 5)
+ (delete-char 0)
+ (goto-char 2)
+ (insert ".....")
+ (goto-char 10)
+ (insert "...........")
+ (goto-char 21)
+ (insert "...")
+ (goto-char 10)
+ (delete-char 13)
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 16)
+ (delete-char 1)
+ (goto-char 16)
+ (delete-char 4)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 3)
+ (widen)
+ (narrow-to-region 2 9)
+ (goto-char 2)
+ (insert "")
+ (goto-char 2)
+ (insert ".............")
+ (goto-char 17)
+ (insert "....")
+ (goto-char 12)
+ (insert "........")
+ (goto-char 8)
+ (widen)
+ (narrow-to-region 32 23)
+ (goto-char 29)
+ (insert ".....")
+ (goto-char 35)
+ (delete-char 2)
+ (goto-char 27)
+ (delete-char 7)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 4 14)
+ (goto-char 8)
+ (insert "...............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 43)
+ (2 . 43)
+ (2 . 43)
+ (2 . 43)
+ (2 . 43)
+ (2 . 44))))))
+
+(ert-deftest overlay-autogenerated-test-45 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 15 48 nil nil nil)
+ (make-overlay 1 47 nil t nil)
+ (make-overlay 43 4 nil t t)
+ (make-overlay 9 45 nil t t)
+ (make-overlay 1 25 nil t t)
+ (make-overlay 5 46 nil t t)
+ (make-overlay 7 14 nil t nil)
+ (make-overlay 1 53 nil nil t)
+ (make-overlay 13 41 nil t nil)
+ (make-overlay 5 31 nil t t)
+ (make-overlay 26 10 nil nil nil)
+ (make-overlay 56 37 nil nil nil)
+ (make-overlay 23 15 nil t nil)
+ (make-overlay 62 30 nil t t)
+ (make-overlay 2 35 nil t t)
+ (make-overlay 46 41 nil nil nil)
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 55)
+ (insert "...........")
+ (goto-char 22)
+ (insert "")
+ (goto-char 73)
+ (delete-char 3)
+ (goto-char 43)
+ (widen)
+ (narrow-to-region 54 63)
+ (goto-char 56)
+ (insert "......")
+ (goto-char 61)
+ (delete-char 3)
+ (goto-char 65)
+ (insert "......")
+ (goto-char 66)
+ (insert ".....")
+ (goto-char 62)
+ (insert ".")
+ (goto-char 74)
+ (insert ".........")
+ (goto-char 76)
+ (delete-char 4)
+ (goto-char 56)
+ (widen)
+ (narrow-to-region 2 46)
+ (goto-char 43)
+ (insert "...........")
+ (goto-char 20)
+ (delete-char 4)
+ (goto-char 38)
+ (delete-char 7)
+ (goto-char 25)
+ (delete-char 21)
+ (goto-char 12)
+ (insert ".........")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 72 61)
+ (goto-char 63)
+ (insert "")
+ (goto-char 65)
+ (delete-char 4)
+ (goto-char 61)
+ (delete-char 5)
+ (goto-char 63)
+ (delete-char 0)
+ (goto-char 63)
+ (delete-char 0)
+ (goto-char 62)
+ (delete-char 0)
+ (goto-char 61)
+ (insert "............")
+ (goto-char 72)
+ (insert "..............")
+ (goto-char 62)
+ (delete-char 7)
+ (goto-char 71)
+ (delete-char 5)
+ (goto-char 75)
+ (widen)
+ (narrow-to-region 29 8)
+ (goto-char 17)
+ (delete-char 2)
+ (goto-char 27)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 36)
+ (1 . 41)
+ (1 . 47)
+ (2 . 40)
+ (4 . 40)
+ (5 . 40)
+ (5 . 40)
+ (7 . 21)
+ (9 . 40)
+ (10 . 37)
+ (20 . 40)
+ (22 . 27)
+ (22 . 42))))))
+
+(ert-deftest overlay-autogenerated-test-46 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 2 43 nil nil t)
+ (make-overlay 44 40 nil nil t)
+ (make-overlay 49 14 nil nil t)
+ (make-overlay 6 55 nil nil nil)
+ (make-overlay 13 52 nil t t)
+ (make-overlay 40 54 nil t nil)
+ (make-overlay 51 41 nil nil t)
+ (make-overlay 7 28 nil nil t)
+ (make-overlay 10 47 nil nil t)
+ (make-overlay 63 21 nil t nil)
+ (make-overlay 4 55 nil nil nil)
+ (make-overlay 52 58 nil t nil)
+ (make-overlay 62 11 nil t t)
+ (make-overlay 22 49 nil t nil)
+ (make-overlay 23 65 nil nil nil)
+ (make-overlay 50 33 nil nil t)
+ (goto-char 22)
+ (insert "..............")
+ (goto-char 12)
+ (insert "....")
+ (goto-char 25)
+ (delete-char 16)
+ (goto-char 14)
+ (delete-char 53)
+ (goto-char 2)
+ (insert "............")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 11)
+ (delete-char 7)
+ (goto-char 9)
+ (widen)
+ (narrow-to-region 11 7)
+ (goto-char 8)
+ (insert "...............")
+ (goto-char 12)
+ (delete-char 4)
+ (goto-char 21)
+ (insert "...")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 7)
+ (delete-char 3)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 12)
+ (delete-char 1)
+ (goto-char 15)
+ (delete-char 0)
+ (goto-char 7)
+ (insert "..............")
+ (goto-char 17)
+ (insert "...........")
+ (goto-char 15)
+ (insert "............")
+ (goto-char 20)
+ (delete-char 5)
+ (goto-char 7)
+ (insert "....")
+ (goto-char 37)
+ (delete-char 7)
+ (goto-char 8)
+ (insert "..........")
+ (goto-char 47)
+ (insert ".............")
+ (goto-char 65)
+ (insert ".......")
+ (goto-char 39)
+ (delete-char 26)
+ (goto-char 14)
+ (delete-char 2)
+ (goto-char 27)
+ (insert ".............")
+ (goto-char 17)
+ (widen)
+ (narrow-to-region 54 32)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 10 3)
+ (goto-char 7)
+ (insert "........")
+ (goto-char 13)
+ (insert "..............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 85))))))
+
+(ert-deftest overlay-autogenerated-test-47 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 62 nil t nil)
+ (make-overlay 14 38 nil nil nil)
+ (make-overlay 63 44 nil t t)
+ (make-overlay 41 41 nil nil t)
+ (make-overlay 19 39 nil nil nil)
+ (make-overlay 10 49 nil t t)
+ (make-overlay 56 38 nil t t)
+ (make-overlay 23 38 nil nil t)
+ (make-overlay 1 64 nil nil t)
+ (make-overlay 21 3 nil t nil)
+ (make-overlay 1 1 nil nil t)
+ (make-overlay 27 61 nil nil nil)
+ (make-overlay 29 59 nil nil nil)
+ (make-overlay 37 30 nil t nil)
+ (make-overlay 47 21 nil nil t)
+ (make-overlay 34 26 nil t nil)
+ (goto-char 6)
+ (delete-char 44)
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 8)
+ (insert "....")
+ (goto-char 17)
+ (delete-char 2)
+ (goto-char 12)
+ (insert "...")
+ (goto-char 20)
+ (insert "")
+ (goto-char 2)
+ (delete-char 20)
+ (goto-char 1)
+ (insert ".........")
+ (goto-char 7)
+ (insert ".............")
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 15)
+ (insert "..........")
+ (goto-char 36)
+ (insert "..............")
+ (goto-char 26)
+ (insert "..............")
+ (goto-char 63)
+ (insert "...........")
+ (goto-char 9)
+ (insert "............")
+ (goto-char 71)
+ (delete-char 17)
+ (goto-char 36)
+ (insert "....")
+ (goto-char 45)
+ (delete-char 31)
+ (goto-char 28)
+ (delete-char 8)
+ (goto-char 10)
+ (delete-char 16)
+ (goto-char 14)
+ (delete-char 4)
+ (goto-char 16)
+ (delete-char 0)
+ (goto-char 15)
+ (insert "")
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 10)
+ (delete-char 2)
+ (goto-char 6)
+ (delete-char 0)
+ (goto-char 1)
+ (insert ".........")
+ (goto-char 23)
+ (insert "......")
+ (goto-char 25)
+ (insert "..........")
+ (goto-char 25)
+ (widen)
+ (narrow-to-region 10 30)
+ (goto-char 21)
+ (delete-char 1)
+ (goto-char 17)
+ (insert "..........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 48)
+ (1 . 48)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 32)
+ (32 . 48)
+ (32 . 48)
+ (32 . 48))))))
+
+(ert-deftest overlay-autogenerated-test-48 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 1 11 nil nil nil)
+ (make-overlay 35 29 nil t t)
+ (make-overlay 24 46 nil nil t)
+ (make-overlay 15 43 nil nil t)
+ (make-overlay 51 49 nil t t)
+ (make-overlay 25 43 nil t nil)
+ (make-overlay 23 59 nil nil nil)
+ (make-overlay 10 4 nil t nil)
+ (make-overlay 40 45 nil nil nil)
+ (make-overlay 42 43 nil nil t)
+ (make-overlay 20 38 nil t nil)
+ (make-overlay 17 49 nil nil nil)
+ (make-overlay 9 25 nil nil t)
+ (make-overlay 13 19 nil nil nil)
+ (make-overlay 44 31 nil t nil)
+ (make-overlay 12 65 nil nil t)
+ (goto-char 59)
+ (widen)
+ (narrow-to-region 28 14)
+ (goto-char 26)
+ (insert "...")
+ (goto-char 30)
+ (delete-char 1)
+ (goto-char 23)
+ (insert "...")
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 45 67)
+ (goto-char 50)
+ (insert "...............")
+ (goto-char 59)
+ (insert "..............")
+ (goto-char 55)
+ (insert ".............")
+ (goto-char 106)
+ (delete-char 0)
+ (goto-char 97)
+ (delete-char 10)
+ (goto-char 67)
+ (delete-char 16)
+ (goto-char 76)
+ (insert "..............")
+ (goto-char 71)
+ (insert ".............")
+ (goto-char 110)
+ (delete-char 0)
+ (goto-char 56)
+ (delete-char 38)
+ (goto-char 61)
+ (delete-char 10)
+ (goto-char 56)
+ (delete-char 5)
+ (goto-char 49)
+ (insert ".......")
+ (goto-char 62)
+ (insert "...")
+ (goto-char 54)
+ (insert "..........")
+ (goto-char 47)
+ (delete-char 10)
+ (goto-char 47)
+ (delete-char 20)
+ (goto-char 46)
+ (insert ".............")
+ (goto-char 56)
+ (insert "...........")
+ (goto-char 70)
+ (delete-char 1)
+ (goto-char 62)
+ (widen)
+ (narrow-to-region 50 64)
+ (goto-char 60)
+ (insert "..")
+ (goto-char 55)
+ (delete-char 6)
+ (goto-char 60)
+ (insert ".............")
+ (goto-char 61)
+ (delete-char 9)
+ (goto-char 64)
+ (delete-char 0)
+ (goto-char 53)
+ (widen)
+ (narrow-to-region 15 62)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((9 . 28)
+ (12 . 73)
+ (13 . 19)
+ (15 . 70)
+ (17 . 70)
+ (20 . 43)
+ (23 . 70)
+ (27 . 70)
+ (28 . 70)
+ (34 . 40)
+ (36 . 70)
+ (45 . 70))))))
+
+(ert-deftest overlay-autogenerated-test-49 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 24 10 nil nil t)
+ (make-overlay 53 23 nil t nil)
+ (make-overlay 53 9 nil nil t)
+ (make-overlay 65 64 nil t t)
+ (make-overlay 48 2 nil nil t)
+ (make-overlay 12 58 nil nil t)
+ (make-overlay 64 64 nil nil nil)
+ (make-overlay 26 13 nil t t)
+ (make-overlay 46 26 nil nil t)
+ (make-overlay 28 59 nil t t)
+ (make-overlay 33 52 nil nil nil)
+ (make-overlay 39 8 nil t t)
+ (make-overlay 9 59 nil t t)
+ (make-overlay 50 45 nil nil t)
+ (make-overlay 41 53 nil nil t)
+ (make-overlay 51 51 nil t nil)
+ (goto-char 61)
+ (insert "..............")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 10 65)
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 11)
+ (insert "...............")
+ (goto-char 77)
+ (delete-char 0)
+ (goto-char 51)
+ (insert "...")
+ (goto-char 75)
+ (insert ".....")
+ (goto-char 77)
+ (delete-char 11)
+ (goto-char 45)
+ (delete-char 0)
+ (goto-char 24)
+ (widen)
+ (narrow-to-region 33 52)
+ (goto-char 46)
+ (insert "..............")
+ (goto-char 46)
+ (insert "..........")
+ (goto-char 39)
+ (widen)
+ (narrow-to-region 46 77)
+ (goto-char 77)
+ (insert "..............")
+ (goto-char 54)
+ (insert ".......")
+ (goto-char 87)
+ (insert ".")
+ (goto-char 70)
+ (delete-char 16)
+ (goto-char 79)
+ (delete-char 0)
+ (goto-char 73)
+ (widen)
+ (narrow-to-region 74 100)
+ (goto-char 91)
+ (insert ".............")
+ (goto-char 80)
+ (delete-char 11)
+ (goto-char 82)
+ (insert "......")
+ (goto-char 108)
+ (delete-char 0)
+ (goto-char 104)
+ (insert ".....")
+ (goto-char 100)
+ (delete-char 1)
+ (goto-char 90)
+ (insert ".............")
+ (goto-char 99)
+ (insert ".............")
+ (goto-char 124)
+ (insert "..............")
+ (goto-char 114)
+ (insert "....")
+ (goto-char 134)
+ (delete-char 0)
+ (goto-char 89)
+ (delete-char 65)
+ (goto-char 75)
+ (delete-char 16)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 75)
+ (8 . 75)
+ (9 . 76)
+ (9 . 82)
+ (27 . 82)
+ (38 . 76)
+ (41 . 75)
+ (43 . 82)
+ (70 . 75))))))
+
+(ert-deftest overlay-autogenerated-test-50 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 29 53 nil t t)
+ (make-overlay 65 64 nil nil nil)
+ (make-overlay 3 31 nil nil t)
+ (make-overlay 45 59 nil t nil)
+ (make-overlay 60 37 nil t t)
+ (make-overlay 7 5 nil t t)
+ (make-overlay 37 24 nil nil nil)
+ (make-overlay 45 20 nil nil nil)
+ (make-overlay 33 42 nil nil t)
+ (make-overlay 47 57 nil t nil)
+ (make-overlay 14 49 nil t t)
+ (make-overlay 14 30 nil t nil)
+ (make-overlay 21 40 nil t t)
+ (make-overlay 5 45 nil t t)
+ (make-overlay 59 40 nil t t)
+ (make-overlay 37 52 nil nil nil)
+ (goto-char 48)
+ (insert "")
+ (goto-char 7)
+ (insert ".........")
+ (goto-char 31)
+ (insert "...........")
+ (goto-char 41)
+ (delete-char 7)
+ (goto-char 21)
+ (delete-char 11)
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 51 53)
+ (goto-char 52)
+ (insert ".....")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 18 24)
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 39 38)
+ (goto-char 38)
+ (insert ".............")
+ (goto-char 41)
+ (insert "......")
+ (goto-char 38)
+ (insert "..............")
+ (goto-char 52)
+ (insert "...............")
+ (goto-char 78)
+ (delete-char 5)
+ (goto-char 50)
+ (insert "..........")
+ (goto-char 50)
+ (delete-char 3)
+ (goto-char 85)
+ (widen)
+ (narrow-to-region 86 1)
+ (goto-char 5)
+ (insert "....")
+ (goto-char 69)
+ (insert "...........")
+ (goto-char 94)
+ (insert "......")
+ (goto-char 98)
+ (delete-char 7)
+ (goto-char 46)
+ (insert "...............")
+ (goto-char 79)
+ (insert "............")
+ (goto-char 89)
+ (insert "")
+ (goto-char 14)
+ (delete-char 63)
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 34)
+ (insert "...")
+ (goto-char 53)
+ (delete-char 14)
+ (goto-char 6)
+ (widen)
+ (narrow-to-region 6 52)
+ (goto-char 42)
+ (insert "...........")
+ (goto-char 40)
+ (insert ".......")
+ (goto-char 46)
+ (widen)
+ (narrow-to-region 1 68)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 14)
+ (9 . 14)
+ (9 . 91)
+ (14 . 14)
+ (14 . 83)
+ (14 . 86)
+ (14 . 88)
+ (14 . 91)
+ (14 . 95)
+ (14 . 104))))))
+
+(ert-deftest overlay-autogenerated-test-51 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 14 5 nil t nil)
+ (make-overlay 62 34 nil nil t)
+ (make-overlay 7 62 nil nil t)
+ (make-overlay 23 12 nil t t)
+ (make-overlay 16 4 nil nil nil)
+ (make-overlay 24 15 nil nil nil)
+ (make-overlay 6 6 nil t t)
+ (make-overlay 25 64 nil t t)
+ (make-overlay 23 6 nil t t)
+ (make-overlay 55 64 nil nil nil)
+ (make-overlay 8 62 nil nil t)
+ (make-overlay 65 65 nil nil nil)
+ (make-overlay 57 51 nil t t)
+ (make-overlay 35 8 nil t nil)
+ (make-overlay 55 13 nil nil t)
+ (make-overlay 60 62 nil nil t)
+ (goto-char 12)
+ (insert "..")
+ (goto-char 66)
+ (insert "............")
+ (goto-char 32)
+ (insert "..")
+ (goto-char 27)
+ (insert ".........")
+ (goto-char 8)
+ (insert ".............")
+ (goto-char 79)
+ (insert ".")
+ (goto-char 47)
+ (insert "....")
+ (goto-char 49)
+ (insert "...")
+ (goto-char 81)
+ (insert "....")
+ (goto-char 112)
+ (delete-char 0)
+ (goto-char 97)
+ (insert ".....")
+ (goto-char 109)
+ (delete-char 5)
+ (goto-char 20)
+ (insert ".....")
+ (goto-char 59)
+ (delete-char 33)
+ (goto-char 87)
+ (insert ".............")
+ (goto-char 98)
+ (insert "....")
+ (goto-char 22)
+ (delete-char 36)
+ (goto-char 45)
+ (insert "..............")
+ (goto-char 42)
+ (delete-char 29)
+ (goto-char 51)
+ (widen)
+ (narrow-to-region 39 41)
+ (goto-char 39)
+ (delete-char 2)
+ (goto-char 39)
+ (insert ".............")
+ (goto-char 51)
+ (insert "......")
+ (goto-char 52)
+ (insert "...............")
+ (goto-char 56)
+ (widen)
+ (narrow-to-region 59 20)
+ (goto-char 56)
+ (insert "............")
+ (goto-char 57)
+ (insert ".")
+ (goto-char 37)
+ (delete-char 12)
+ (goto-char 39)
+ (delete-char 11)
+ (goto-char 38)
+ (delete-char 8)
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 65 26)
+ (goto-char 40)
+ (widen)
+ (narrow-to-region 27 55)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((7 . 55)
+ (8 . 55)
+ (22 . 29)
+ (23 . 55)
+ (23 . 56)
+ (24 . 31)
+ (29 . 56)
+ (37 . 55))))))
+
+(ert-deftest overlay-autogenerated-test-52 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 32 nil nil nil)
+ (make-overlay 44 54 nil nil t)
+ (make-overlay 27 50 nil nil nil)
+ (make-overlay 55 35 nil nil t)
+ (make-overlay 40 46 nil nil t)
+ (make-overlay 56 63 nil t nil)
+ (make-overlay 29 48 nil nil nil)
+ (make-overlay 45 24 nil t nil)
+ (make-overlay 60 25 nil t nil)
+ (make-overlay 55 41 nil t nil)
+ (make-overlay 55 1 nil nil t)
+ (make-overlay 30 45 nil t t)
+ (make-overlay 26 19 nil nil t)
+ (make-overlay 61 5 nil nil nil)
+ (make-overlay 33 5 nil nil nil)
+ (make-overlay 42 18 nil t nil)
+ (goto-char 55)
+ (insert ".")
+ (goto-char 49)
+ (delete-char 12)
+ (goto-char 41)
+ (insert "..........")
+ (goto-char 27)
+ (insert ".....")
+ (goto-char 58)
+ (insert "...........")
+ (goto-char 24)
+ (delete-char 23)
+ (goto-char 47)
+ (delete-char 9)
+ (goto-char 4)
+ (insert "...")
+ (goto-char 10)
+ (delete-char 32)
+ (goto-char 4)
+ (insert "..............")
+ (goto-char 29)
+ (insert "....")
+ (goto-char 28)
+ (delete-char 2)
+ (goto-char 34)
+ (insert "...........")
+ (goto-char 9)
+ (insert "......")
+ (goto-char 5)
+ (insert "")
+ (goto-char 45)
+ (delete-char 1)
+ (goto-char 18)
+ (insert ".........")
+ (goto-char 36)
+ (delete-char 5)
+ (goto-char 15)
+ (delete-char 27)
+ (goto-char 15)
+ (delete-char 10)
+ (goto-char 16)
+ (delete-char 2)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 10 2)
+ (goto-char 9)
+ (delete-char 1)
+ (goto-char 3)
+ (delete-char 2)
+ (goto-char 2)
+ (widen)
+ (narrow-to-region 9 10)
+ (goto-char 9)
+ (insert "...........")
+ (goto-char 19)
+ (delete-char 0)
+ (goto-char 14)
+ (delete-char 3)
+ (goto-char 11)
+ (delete-char 2)
+ (goto-char 9)
+ (delete-char 6)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 10)
+ (insert "....")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 17))))))
+
+(ert-deftest overlay-autogenerated-test-53 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 10 30 nil nil nil)
+ (make-overlay 11 57 nil t nil)
+ (make-overlay 59 56 nil nil t)
+ (make-overlay 20 37 nil nil t)
+ (make-overlay 41 29 nil nil nil)
+ (make-overlay 31 10 nil nil t)
+ (make-overlay 6 36 nil nil nil)
+ (make-overlay 12 54 nil nil nil)
+ (make-overlay 25 26 nil t t)
+ (make-overlay 21 19 nil nil t)
+ (make-overlay 1 21 nil nil t)
+ (make-overlay 48 51 nil nil nil)
+ (make-overlay 54 55 nil t nil)
+ (make-overlay 64 48 nil t t)
+ (make-overlay 56 25 nil nil t)
+ (make-overlay 12 60 nil t nil)
+ (goto-char 41)
+ (delete-char 1)
+ (goto-char 63)
+ (insert "")
+ (goto-char 14)
+ (delete-char 5)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 41)
+ (widen)
+ (narrow-to-region 12 1)
+ (goto-char 1)
+ (delete-char 3)
+ (goto-char 9)
+ (delete-char 0)
+ (goto-char 5)
+ (insert "..............")
+ (goto-char 1)
+ (insert "..........")
+ (goto-char 29)
+ (insert "...............")
+ (goto-char 4)
+ (insert "..")
+ (goto-char 31)
+ (delete-char 15)
+ (goto-char 31)
+ (insert "")
+ (goto-char 27)
+ (insert "......")
+ (goto-char 6)
+ (insert "...")
+ (goto-char 23)
+ (widen)
+ (narrow-to-region 23 47)
+ (goto-char 37)
+ (delete-char 2)
+ (goto-char 35)
+ (delete-char 5)
+ (goto-char 38)
+ (delete-char 2)
+ (goto-char 30)
+ (insert ".......")
+ (goto-char 45)
+ (widen)
+ (narrow-to-region 13 2)
+ (goto-char 9)
+ (delete-char 1)
+ (goto-char 3)
+ (insert ".....")
+ (goto-char 2)
+ (insert "...............")
+ (goto-char 16)
+ (delete-char 5)
+ (goto-char 20)
+ (insert ".....")
+ (goto-char 26)
+ (delete-char 0)
+ (goto-char 26)
+ (widen)
+ (narrow-to-region 76 98)
+ (goto-char 88)
+ (insert ".........")
+ (goto-char 92)
+ (insert ".")
+ (goto-char 108)
+ (delete-char 0)
+ (goto-char 103)
+ (delete-char 3)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 79)
+ (37 . 103)
+ (61 . 88)
+ (61 . 99)
+ (74 . 121)
+ (75 . 118)
+ (75 . 124)
+ (77 . 79)
+ (78 . 103)
+ (83 . 84)
+ (83 . 120)
+ (87 . 106))))))
+
+(ert-deftest overlay-autogenerated-test-54 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 36 nil t t)
+ (make-overlay 55 49 nil nil t)
+ (make-overlay 12 25 nil nil t)
+ (make-overlay 16 37 nil t t)
+ (make-overlay 42 25 nil t t)
+ (make-overlay 8 41 nil t t)
+ (make-overlay 13 27 nil nil t)
+ (make-overlay 52 22 nil t nil)
+ (make-overlay 36 17 nil t nil)
+ (make-overlay 1 52 nil t nil)
+ (make-overlay 55 5 nil nil t)
+ (make-overlay 50 50 nil t nil)
+ (make-overlay 32 15 nil t nil)
+ (make-overlay 39 26 nil t nil)
+ (make-overlay 26 4 nil nil nil)
+ (make-overlay 38 47 nil t t)
+ (goto-char 23)
+ (insert ".")
+ (goto-char 57)
+ (delete-char 6)
+ (goto-char 54)
+ (insert "..............")
+ (goto-char 46)
+ (insert "...............")
+ (goto-char 29)
+ (insert ".......")
+ (goto-char 58)
+ (delete-char 21)
+ (goto-char 45)
+ (delete-char 4)
+ (goto-char 50)
+ (delete-char 4)
+ (goto-char 20)
+ (insert ".........")
+ (goto-char 16)
+ (insert "......")
+ (goto-char 17)
+ (insert ".....")
+ (goto-char 63)
+ (insert "........")
+ (goto-char 83)
+ (insert "....")
+ (goto-char 73)
+ (delete-char 8)
+ (goto-char 69)
+ (insert "...........")
+ (goto-char 48)
+ (widen)
+ (narrow-to-region 19 31)
+ (goto-char 22)
+ (delete-char 3)
+ (goto-char 23)
+ (delete-char 5)
+ (goto-char 20)
+ (insert "............")
+ (goto-char 23)
+ (delete-char 11)
+ (goto-char 19)
+ (insert "..........")
+ (goto-char 23)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 1)
+ (goto-char 33)
+ (delete-char 5)
+ (goto-char 27)
+ (insert "..........")
+ (goto-char 35)
+ (delete-char 8)
+ (goto-char 35)
+ (insert ".")
+ (goto-char 20)
+ (insert "......")
+ (goto-char 22)
+ (delete-char 22)
+ (goto-char 23)
+ (delete-char 0)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 1 41)
+ (goto-char 13)
+ (insert ".......")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 83)
+ (4 . 46)
+ (5 . 97)
+ (8 . 83)
+ (12 . 45)
+ (13 . 47)
+ (22 . 59)
+ (30 . 82)
+ (30 . 83)
+ (41 . 83)
+ (45 . 83)
+ (46 . 83))))))
+
+(ert-deftest overlay-autogenerated-test-55 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 58 20 nil nil nil)
+ (make-overlay 60 33 nil t nil)
+ (make-overlay 6 27 nil nil nil)
+ (make-overlay 53 31 nil nil t)
+ (make-overlay 30 55 nil t t)
+ (make-overlay 4 64 nil t t)
+ (make-overlay 51 31 nil nil t)
+ (make-overlay 4 65 nil t t)
+ (make-overlay 57 62 nil t t)
+ (make-overlay 28 7 nil nil t)
+ (make-overlay 61 48 nil t nil)
+ (make-overlay 23 54 nil nil t)
+ (make-overlay 47 49 nil nil nil)
+ (make-overlay 12 52 nil t nil)
+ (make-overlay 39 57 nil t t)
+ (make-overlay 28 61 nil nil t)
+ (goto-char 8)
+ (insert "..............")
+ (goto-char 63)
+ (delete-char 3)
+ (goto-char 67)
+ (delete-char 6)
+ (goto-char 3)
+ (widen)
+ (narrow-to-region 10 67)
+ (goto-char 43)
+ (insert ".............")
+ (goto-char 20)
+ (insert "...............")
+ (goto-char 18)
+ (insert "..")
+ (goto-char 37)
+ (delete-char 47)
+ (goto-char 34)
+ (insert "..............")
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 29 36)
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 31)
+ (insert ".......")
+ (goto-char 40)
+ (delete-char 0)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 40 19)
+ (goto-char 40)
+ (insert "..")
+ (goto-char 37)
+ (delete-char 0)
+ (goto-char 40)
+ (delete-char 1)
+ (goto-char 34)
+ (delete-char 4)
+ (goto-char 33)
+ (insert "..............")
+ (goto-char 19)
+ (widen)
+ (narrow-to-region 78 70)
+ (goto-char 77)
+ (insert ".........")
+ (goto-char 80)
+ (delete-char 1)
+ (goto-char 73)
+ (delete-char 3)
+ (goto-char 70)
+ (insert ".........")
+ (goto-char 75)
+ (delete-char 10)
+ (goto-char 74)
+ (delete-char 3)
+ (goto-char 73)
+ (insert "...............")
+ (goto-char 90)
+ (insert "......")
+ (goto-char 94)
+ (insert "..............")
+ (goto-char 101)
+ (insert "........")
+ (goto-char 111)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 132)
+ (4 . 133)
+ (65 . 89)
+ (65 . 89)
+ (65 . 89)
+ (65 . 89)
+ (65 . 129)
+ (65 . 130)
+ (65 . 130)
+ (65 . 130)
+ (65 . 130)
+ (89 . 89)
+ (89 . 130))))))
+
+(ert-deftest overlay-autogenerated-test-56 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 7 14 nil nil t)
+ (make-overlay 10 10 nil nil t)
+ (make-overlay 21 23 nil nil t)
+ (make-overlay 4 44 nil t nil)
+ (make-overlay 42 16 nil t t)
+ (make-overlay 1 57 nil t nil)
+ (make-overlay 15 27 nil nil nil)
+ (make-overlay 31 1 nil t nil)
+ (make-overlay 56 45 nil t t)
+ (make-overlay 46 19 nil t nil)
+ (make-overlay 15 6 nil nil nil)
+ (make-overlay 31 26 nil nil t)
+ (make-overlay 39 41 nil t t)
+ (make-overlay 52 48 nil nil t)
+ (make-overlay 44 2 nil t nil)
+ (make-overlay 60 7 nil nil t)
+ (goto-char 49)
+ (delete-char 11)
+ (goto-char 43)
+ (delete-char 9)
+ (goto-char 42)
+ (delete-char 2)
+ (goto-char 12)
+ (insert "...........")
+ (goto-char 36)
+ (insert ".........")
+ (goto-char 1)
+ (insert "......")
+ (goto-char 67)
+ (delete-char 0)
+ (goto-char 47)
+ (insert ".............")
+ (goto-char 57)
+ (insert "........")
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 75 33)
+ (goto-char 41)
+ (delete-char 28)
+ (goto-char 43)
+ (delete-char 0)
+ (goto-char 33)
+ (delete-char 5)
+ (goto-char 38)
+ (insert "..")
+ (goto-char 42)
+ (delete-char 0)
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 38)
+ (insert "............")
+ (goto-char 51)
+ (insert ".......")
+ (goto-char 48)
+ (insert "..")
+ (goto-char 55)
+ (insert ".")
+ (goto-char 33)
+ (delete-char 8)
+ (goto-char 42)
+ (insert "..")
+ (goto-char 45)
+ (insert "..")
+ (goto-char 59)
+ (insert ".............")
+ (goto-char 53)
+ (insert ".......")
+ (goto-char 81)
+ (delete-char 0)
+ (goto-char 44)
+ (delete-char 36)
+ (goto-char 38)
+ (delete-char 8)
+ (goto-char 33)
+ (insert ".............")
+ (goto-char 41)
+ (insert "..............")
+ (goto-char 65)
+ (insert "...............")
+ (goto-char 61)
+ (insert "...")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((7 . 86)
+ (7 . 97)
+ (8 . 97)
+ (10 . 97)
+ (13 . 97)
+ (32 . 68)
+ (33 . 60)
+ (60 . 97)
+ (60 . 97)
+ (68 . 86))))))
+
+(ert-deftest overlay-autogenerated-test-57 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 52 31 nil t nil)
+ (make-overlay 39 17 nil t nil)
+ (make-overlay 19 20 nil t t)
+ (make-overlay 18 3 nil nil t)
+ (make-overlay 19 47 nil nil t)
+ (make-overlay 38 54 nil nil nil)
+ (make-overlay 30 51 nil nil t)
+ (make-overlay 29 60 nil t t)
+ (make-overlay 57 38 nil nil nil)
+ (make-overlay 13 41 nil t nil)
+ (make-overlay 9 44 nil t nil)
+ (make-overlay 30 55 nil t nil)
+ (make-overlay 33 10 nil nil nil)
+ (make-overlay 14 35 nil nil t)
+ (make-overlay 53 50 nil t nil)
+ (make-overlay 25 28 nil nil t)
+ (goto-char 40)
+ (insert "..")
+ (goto-char 64)
+ (insert "........")
+ (goto-char 47)
+ (insert "............")
+ (goto-char 65)
+ (delete-char 0)
+ (goto-char 86)
+ (delete-char 1)
+ (goto-char 59)
+ (delete-char 11)
+ (goto-char 64)
+ (delete-char 8)
+ (goto-char 53)
+ (delete-char 0)
+ (goto-char 28)
+ (delete-char 8)
+ (goto-char 6)
+ (delete-char 33)
+ (goto-char 14)
+ (delete-char 2)
+ (goto-char 2)
+ (delete-char 10)
+ (goto-char 3)
+ (insert "..")
+ (goto-char 5)
+ (insert ".........")
+ (goto-char 1)
+ (insert "........")
+ (goto-char 10)
+ (delete-char 4)
+ (goto-char 26)
+ (insert "........")
+ (goto-char 23)
+ (insert "....")
+ (goto-char 1)
+ (widen)
+ (narrow-to-region 15 23)
+ (goto-char 19)
+ (insert "...")
+ (goto-char 24)
+ (delete-char 0)
+ (goto-char 19)
+ (insert ".......")
+ (goto-char 18)
+ (insert "..")
+ (goto-char 33)
+ (insert "...")
+ (goto-char 32)
+ (insert "...............")
+ (goto-char 29)
+ (delete-char 10)
+ (goto-char 29)
+ (insert "..........")
+ (goto-char 50)
+ (insert "")
+ (goto-char 16)
+ (insert ".........")
+ (goto-char 52)
+ (widen)
+ (narrow-to-region 59 15)
+ (goto-char 35)
+ (delete-char 4)
+ (goto-char 18)
+ (insert "....")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((10 . 57)
+ (10 . 57)
+ (10 . 57)
+ (10 . 60)
+ (10 . 60)
+ (10 . 61)
+ (10 . 68)
+ (57 . 57))))))
+
+(ert-deftest overlay-autogenerated-test-58 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 8 16 nil t nil)
+ (make-overlay 57 27 nil nil nil)
+ (make-overlay 15 62 nil nil nil)
+ (make-overlay 32 33 nil nil t)
+ (make-overlay 47 27 nil nil t)
+ (make-overlay 41 4 nil nil t)
+ (make-overlay 57 61 nil t nil)
+ (make-overlay 18 43 nil nil t)
+ (make-overlay 64 51 nil t t)
+ (make-overlay 44 26 nil nil nil)
+ (make-overlay 9 13 nil nil t)
+ (make-overlay 41 65 nil nil t)
+ (make-overlay 23 13 nil t t)
+ (make-overlay 26 59 nil t t)
+ (make-overlay 65 65 nil t t)
+ (make-overlay 15 7 nil nil nil)
+ (goto-char 41)
+ (insert "........")
+ (goto-char 35)
+ (delete-char 14)
+ (goto-char 32)
+ (widen)
+ (narrow-to-region 23 46)
+ (goto-char 41)
+ (delete-char 5)
+ (goto-char 29)
+ (delete-char 10)
+ (goto-char 31)
+ (insert ".")
+ (goto-char 29)
+ (insert "........")
+ (goto-char 27)
+ (delete-char 7)
+ (goto-char 29)
+ (insert "")
+ (goto-char 24)
+ (insert "............")
+ (goto-char 43)
+ (delete-char 1)
+ (goto-char 31)
+ (delete-char 9)
+ (goto-char 34)
+ (widen)
+ (narrow-to-region 20 14)
+ (goto-char 20)
+ (delete-char 0)
+ (goto-char 17)
+ (insert "...........")
+ (goto-char 31)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "...........")
+ (goto-char 17)
+ (delete-char 8)
+ (goto-char 23)
+ (delete-char 5)
+ (goto-char 20)
+ (insert "..........")
+ (goto-char 33)
+ (widen)
+ (narrow-to-region 16 29)
+ (goto-char 24)
+ (insert "...............")
+ (goto-char 44)
+ (delete-char 0)
+ (goto-char 30)
+ (insert "....")
+ (goto-char 27)
+ (widen)
+ (narrow-to-region 4 22)
+ (goto-char 10)
+ (insert "..............")
+ (goto-char 36)
+ (insert "..")
+ (goto-char 10)
+ (delete-char 21)
+ (goto-char 14)
+ (delete-char 1)
+ (goto-char 14)
+ (insert "...........")
+ (goto-char 12)
+ (insert "........")
+ (goto-char 32)
+ (insert "........")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 92)
+ (7 . 10)
+ (8 . 10)
+ (9 . 10)
+ (10 . 82)
+ (10 . 104))))))
+
+(ert-deftest overlay-autogenerated-test-59 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 46 30 nil t t)
+ (make-overlay 3 26 nil nil nil)
+ (make-overlay 36 28 nil t t)
+ (make-overlay 49 49 nil t t)
+ (make-overlay 27 61 nil t nil)
+ (make-overlay 14 16 nil nil nil)
+ (make-overlay 50 61 nil t nil)
+ (make-overlay 59 63 nil nil nil)
+ (make-overlay 36 34 nil t nil)
+ (make-overlay 35 29 nil nil nil)
+ (make-overlay 5 65 nil nil nil)
+ (make-overlay 20 61 nil nil t)
+ (make-overlay 10 42 nil nil nil)
+ (make-overlay 47 49 nil nil t)
+ (make-overlay 12 4 nil nil nil)
+ (make-overlay 32 24 nil t t)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 32)
+ (delete-char 2)
+ (goto-char 61)
+ (insert ".........")
+ (goto-char 36)
+ (insert "........")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 8 55)
+ (goto-char 21)
+ (insert "....")
+ (goto-char 32)
+ (delete-char 15)
+ (goto-char 30)
+ (delete-char 5)
+ (goto-char 31)
+ (insert "......")
+ (goto-char 18)
+ (insert "..")
+ (goto-char 14)
+ (insert ".............")
+ (goto-char 34)
+ (insert "............")
+ (goto-char 51)
+ (widen)
+ (narrow-to-region 58 31)
+ (goto-char 50)
+ (delete-char 5)
+ (goto-char 53)
+ (insert ".........")
+ (goto-char 56)
+ (insert "...............")
+ (goto-char 45)
+ (delete-char 1)
+ (goto-char 67)
+ (insert "............")
+ (goto-char 84)
+ (insert "")
+ (goto-char 39)
+ (delete-char 27)
+ (goto-char 39)
+ (delete-char 21)
+ (goto-char 32)
+ (insert "............")
+ (goto-char 36)
+ (widen)
+ (narrow-to-region 7 37)
+ (goto-char 11)
+ (insert ".......")
+ (goto-char 21)
+ (delete-char 13)
+ (goto-char 15)
+ (insert "....")
+ (goto-char 9)
+ (insert ".............")
+ (goto-char 13)
+ (delete-char 21)
+ (goto-char 21)
+ (delete-char 6)
+ (goto-char 16)
+ (insert ".......")
+ (goto-char 22)
+ (insert "")
+ (goto-char 27)
+ (delete-char 0)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 42)
+ (4 . 16)
+ (5 . 83)
+ (13 . 51)
+ (25 . 27))))))
+
+(ert-deftest overlay-autogenerated-test-60 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 38 32 nil t nil)
+ (make-overlay 32 42 nil t nil)
+ (make-overlay 29 11 nil nil t)
+ (make-overlay 52 22 nil t t)
+ (make-overlay 39 59 nil t nil)
+ (make-overlay 41 30 nil t t)
+ (make-overlay 29 61 nil nil t)
+ (make-overlay 11 45 nil nil nil)
+ (make-overlay 46 17 nil nil t)
+ (make-overlay 35 51 nil t t)
+ (make-overlay 22 13 nil nil t)
+ (make-overlay 52 34 nil nil t)
+ (make-overlay 59 4 nil nil t)
+ (make-overlay 8 22 nil nil nil)
+ (make-overlay 4 49 nil nil nil)
+ (make-overlay 52 45 nil t t)
+ (goto-char 48)
+ (delete-char 16)
+ (goto-char 37)
+ (delete-char 8)
+ (goto-char 14)
+ (insert "...............")
+ (goto-char 40)
+ (delete-char 16)
+ (goto-char 19)
+ (insert ".........")
+ (goto-char 16)
+ (insert "......")
+ (goto-char 10)
+ (insert "........")
+ (goto-char 11)
+ (insert "...............")
+ (goto-char 22)
+ (insert ".")
+ (goto-char 62)
+ (delete-char 16)
+ (goto-char 14)
+ (delete-char 11)
+ (goto-char 47)
+ (insert "....")
+ (goto-char 33)
+ (insert ".............")
+ (goto-char 49)
+ (delete-char 13)
+ (goto-char 28)
+ (insert "..")
+ (goto-char 35)
+ (delete-char 13)
+ (goto-char 44)
+ (insert "....")
+ (goto-char 34)
+ (delete-char 14)
+ (goto-char 23)
+ (insert ".....")
+ (goto-char 25)
+ (delete-char 4)
+ (goto-char 33)
+ (insert ".....")
+ (goto-char 27)
+ (delete-char 3)
+ (goto-char 16)
+ (widen)
+ (narrow-to-region 36 37)
+ (goto-char 36)
+ (delete-char 1)
+ (goto-char 36)
+ (insert ".......")
+ (goto-char 37)
+ (widen)
+ (narrow-to-region 35 31)
+ (goto-char 34)
+ (delete-char 0)
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 31)
+ (widen)
+ (narrow-to-region 24 3)
+ (goto-char 22)
+ (delete-char 2)
+ (goto-char 22)
+ (insert ".............")
+ (goto-char 4)
+ (insert ".")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((4 . 54)
+ (4 . 54)
+ (9 . 46))))))
+
+(ert-deftest overlay-autogenerated-test-61 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 45 56 nil t nil)
+ (make-overlay 60 45 nil nil nil)
+ (make-overlay 26 8 nil t t)
+ (make-overlay 63 39 nil nil nil)
+ (make-overlay 18 11 nil t nil)
+ (make-overlay 22 64 nil nil t)
+ (make-overlay 8 41 nil nil t)
+ (make-overlay 6 51 nil t t)
+ (make-overlay 38 26 nil t t)
+ (make-overlay 7 46 nil t nil)
+ (make-overlay 2 42 nil nil t)
+ (make-overlay 44 64 nil nil nil)
+ (make-overlay 7 62 nil t nil)
+ (make-overlay 8 40 nil nil t)
+ (make-overlay 62 36 nil t t)
+ (make-overlay 61 27 nil nil nil)
+ (goto-char 21)
+ (delete-char 0)
+ (goto-char 8)
+ (insert "")
+ (goto-char 55)
+ (insert "......")
+ (goto-char 38)
+ (delete-char 25)
+ (goto-char 37)
+ (delete-char 4)
+ (goto-char 12)
+ (delete-char 4)
+ (goto-char 3)
+ (delete-char 26)
+ (goto-char 10)
+ (insert ".......")
+ (goto-char 18)
+ (delete-char 0)
+ (goto-char 16)
+ (insert ".............")
+ (goto-char 18)
+ (delete-char 3)
+ (goto-char 7)
+ (insert "...")
+ (goto-char 20)
+ (insert "........")
+ (goto-char 38)
+ (delete-char 0)
+ (goto-char 1)
+ (delete-char 36)
+ (goto-char 3)
+ (delete-char 1)
+ (goto-char 2)
+ (insert "......")
+ (goto-char 4)
+ (insert ".......")
+ (goto-char 2)
+ (insert "...........")
+ (goto-char 27)
+ (insert ".....")
+ (goto-char 15)
+ (insert "...............")
+ (goto-char 2)
+ (insert "......")
+ (goto-char 17)
+ (delete-char 8)
+ (goto-char 15)
+ (delete-char 7)
+ (goto-char 33)
+ (delete-char 5)
+ (goto-char 13)
+ (insert "...........")
+ (goto-char 34)
+ (insert "...............")
+ (goto-char 33)
+ (insert "")
+ (goto-char 51)
+ (insert "....")
+ (goto-char 14)
+ (delete-char 36)
+ (goto-char 16)
+ (delete-char 1)
+ (goto-char 14)
+ (delete-char 8)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 1)
+ (1 . 18)
+ (1 . 18))))))
+
+(ert-deftest overlay-autogenerated-test-62 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 25 36 nil t nil)
+ (make-overlay 38 6 nil t nil)
+ (make-overlay 40 63 nil nil t)
+ (make-overlay 34 23 nil nil nil)
+ (make-overlay 48 46 nil nil nil)
+ (make-overlay 43 57 nil t t)
+ (make-overlay 6 53 nil t t)
+ (make-overlay 37 27 nil t t)
+ (make-overlay 8 39 nil t nil)
+ (make-overlay 62 6 nil nil nil)
+ (make-overlay 51 6 nil t t)
+ (make-overlay 58 11 nil nil t)
+ (make-overlay 19 25 nil t nil)
+ (make-overlay 13 8 nil nil nil)
+ (make-overlay 19 8 nil nil t)
+ (make-overlay 39 5 nil t t)
+ (goto-char 51)
+ (delete-char 5)
+ (goto-char 16)
+ (delete-char 9)
+ (goto-char 18)
+ (insert "")
+ (goto-char 47)
+ (delete-char 4)
+ (goto-char 24)
+ (insert ".........")
+ (goto-char 24)
+ (insert ".....")
+ (goto-char 18)
+ (insert "...........")
+ (goto-char 5)
+ (delete-char 6)
+ (goto-char 30)
+ (insert "...........")
+ (goto-char 8)
+ (insert ".............")
+ (goto-char 78)
+ (insert "............")
+ (goto-char 67)
+ (insert "")
+ (goto-char 58)
+ (insert "")
+ (goto-char 5)
+ (insert ".")
+ (goto-char 79)
+ (widen)
+ (narrow-to-region 51 55)
+ (goto-char 51)
+ (insert "....")
+ (goto-char 58)
+ (widen)
+ (narrow-to-region 36 37)
+ (goto-char 37)
+ (insert "....")
+ (goto-char 40)
+ (insert ".......")
+ (goto-char 47)
+ (delete-char 1)
+ (goto-char 43)
+ (delete-char 4)
+ (goto-char 37)
+ (insert "........")
+ (goto-char 49)
+ (insert "............")
+ (goto-char 42)
+ (widen)
+ (narrow-to-region 75 111)
+ (goto-char 104)
+ (widen)
+ (narrow-to-region 21 95)
+ (goto-char 22)
+ (widen)
+ (narrow-to-region 64 79)
+ (goto-char 64)
+ (delete-char 0)
+ (goto-char 68)
+ (insert "........")
+ (goto-char 82)
+ (insert "")
+ (goto-char 81)
+ (insert "........")
+ (goto-char 92)
+ (delete-char 2)
+ (goto-char 87)
+ (insert ".")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((5 . 145)
+ (5 . 148)
+ (6 . 118)
+ (6 . 119)
+ (6 . 119)
+ (6 . 143)
+ (6 . 143)
+ (24 . 114)
+ (24 . 116)
+ (63 . 117))))))
+
+(ert-deftest overlay-autogenerated-test-63 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 9 49 nil t nil)
+ (make-overlay 9 16 nil nil nil)
+ (make-overlay 64 2 nil t t)
+ (make-overlay 17 31 nil nil t)
+ (make-overlay 24 51 nil nil nil)
+ (make-overlay 27 56 nil t t)
+ (make-overlay 21 4 nil nil nil)
+ (make-overlay 24 29 nil t t)
+ (make-overlay 4 63 nil nil t)
+ (make-overlay 34 49 nil t nil)
+ (make-overlay 19 47 nil nil t)
+ (make-overlay 8 50 nil t nil)
+ (make-overlay 49 61 nil t nil)
+ (make-overlay 52 10 nil t t)
+ (make-overlay 64 30 nil t nil)
+ (make-overlay 5 13 nil t nil)
+ (goto-char 27)
+ (insert "........")
+ (goto-char 42)
+ (insert "......")
+ (goto-char 48)
+ (insert "....")
+ (goto-char 55)
+ (widen)
+ (narrow-to-region 10 5)
+ (goto-char 8)
+ (insert ".............")
+ (goto-char 19)
+ (insert "......")
+ (goto-char 19)
+ (delete-char 3)
+ (goto-char 8)
+ (delete-char 3)
+ (goto-char 9)
+ (insert ".......")
+ (goto-char 29)
+ (insert "...............")
+ (goto-char 38)
+ (insert ".......")
+ (goto-char 34)
+ (insert "......")
+ (goto-char 28)
+ (delete-char 20)
+ (goto-char 22)
+ (insert "............")
+ (goto-char 21)
+ (delete-char 23)
+ (goto-char 25)
+ (delete-char 2)
+ (goto-char 19)
+ (delete-char 2)
+ (goto-char 12)
+ (delete-char 6)
+ (goto-char 12)
+ (delete-char 0)
+ (goto-char 13)
+ (delete-char 0)
+ (goto-char 12)
+ (insert "........")
+ (goto-char 23)
+ (delete-char 2)
+ (goto-char 5)
+ (insert "...............")
+ (goto-char 28)
+ (delete-char 0)
+ (goto-char 16)
+ (insert "..........")
+ (goto-char 8)
+ (delete-char 17)
+ (goto-char 27)
+ (delete-char 0)
+ (goto-char 12)
+ (insert ".")
+ (goto-char 14)
+ (delete-char 12)
+ (goto-char 11)
+ (insert "..............")
+ (goto-char 34)
+ (insert "")
+ (goto-char 25)
+ (delete-char 8)
+ (should
+ (equal
+ (test-overlay-regions)
+ '((2 . 98)
+ (4 . 37)
+ (4 . 97)
+ (25 . 29)
+ (25 . 32)
+ (25 . 84))))))
+
+(ert-deftest overlay-autogenerated-test-64 nil
+ (with-temp-buffer
+ (insert "................................................................")
+ (make-overlay 31 10 nil nil nil)
+ (make-overlay 17 58 nil nil t)
+ (make-overlay 20 21 nil t nil)
+ (make-overlay 3 47 nil t t)
+ (make-overlay 47 43 nil t t)
+ (make-overlay 54 8 nil nil t)
+ (make-overlay 51 26 nil t nil)
+ (make-overlay 60 14 nil t nil)
+ (make-overlay 38 6 nil nil t)
+ (make-overlay 41 9 nil nil nil)
+ (make-overlay 44 38 nil nil t)
+ (make-overlay 55 48 nil nil t)
+ (make-overlay 10 41 nil nil t)
+ (make-overlay 35 49 nil t nil)
+ (make-overlay 50 46 nil nil nil)
+ (make-overlay 28 28 nil t nil)
+ (goto-char 59)
+ (delete-char 3)
+ (goto-char 28)
+ (widen)
+ (narrow-to-region 13 7)
+ (goto-char 11)
+ (insert ".")
+ (goto-char 9)
+ (delete-char 3)
+ (goto-char 8)
+ (delete-char 0)
+ (goto-char 7)
+ (insert ".............")
+ (goto-char 9)
+ (insert "..........")
+ (goto-char 22)
+ (delete-char 1)
+ (goto-char 31)
+ (delete-char 2)
+ (goto-char 22)
+ (insert ".........")
+ (goto-char 33)
+ (delete-char 1)
+ (goto-char 29)
+ (widen)
+ (narrow-to-region 59 51)
+ (goto-char 52)
+ (insert ".........")
+ (goto-char 53)
+ (insert "........")
+ (goto-char 53)
+ (delete-char 4)
+ (goto-char 54)
+ (insert "........")
+ (goto-char 53)
+ (insert "....")
+ (goto-char 75)
+ (widen)
+ (goto-char 70)
+ (delete-char 2)
+ (goto-char 108)
+ (delete-char 1)
+ (goto-char 80)
+ (widen)
+ (goto-char 70)
+ (widen)
+ (narrow-to-region 49 63)
+ (goto-char 49)
+ (insert "...")
+ (goto-char 66)
+ (delete-char 0)
+ (goto-char 63)
+ (delete-char 3)
+ (goto-char 59)
+ (insert "..........")
+ (goto-char 56)
+ (delete-char 6)
+ (goto-char 60)
+ (insert ".........")
+ (goto-char 62)
+ (widen)
+ (goto-char 58)
+ (insert ".............")
+ (goto-char 105)
+ (widen)
+ (narrow-to-region 94 109)
+ (goto-char 103)
+ (insert "............")
+ (should
+ (equal
+ (test-overlay-regions)
+ '((3 . 134)
+ (6 . 125)
+ (38 . 141)
+ (39 . 118)
+ (39 . 128)
+ (39 . 128)
+ (40 . 146)
+ (43 . 145)
+ (101 . 138)
+ (103 . 103))))))
+
+) ;; End of `when nil' for autogenerated insert/delete/narrow tests.
+
+(ert-deftest buffer-multibyte-overlong-sequences ()
+ (dolist (uni '("\xE0\x80\x80"
+ "\xF0\x80\x80\x80"
+ "\xF8\x8F\xBF\xBF\x80"))
+ (let ((multi (string-to-multibyte uni)))
+ (should
+ (string-equal
+ multi
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert uni)
+ (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)))))
+
+(ert-deftest buffer-tests-inhibit-buffer-hooks ()
+ "Test `get-buffer-create' argument INHIBIT-BUFFER-HOOKS."
+ (let* (run-bluh (bluh (lambda () (setq run-bluh t))))
+ (unwind-protect
+ (let* ( run-kbh (kbh (lambda () (setq run-kbh t)))
+ run-kbqf (kbqf (lambda () (setq run-kbqf t))) )
+
+ ;; Inhibited.
+ (add-hook 'buffer-list-update-hook bluh)
+ (with-current-buffer (generate-new-buffer " foo" t)
+ (add-hook 'kill-buffer-hook kbh nil t)
+ (add-hook 'kill-buffer-query-functions kbqf nil t)
+ (kill-buffer))
+ (with-temp-buffer (ignore))
+ (with-output-to-string (ignore))
+ (should-not run-bluh)
+ (should-not run-kbh)
+ (should-not run-kbqf)
+
+ ;; Not inhibited.
+ (with-current-buffer (generate-new-buffer " foo")
+ (should run-bluh)
+ (add-hook 'kill-buffer-hook kbh nil t)
+ (add-hook 'kill-buffer-query-functions kbqf nil t)
+ (kill-buffer))
+ (should run-kbh)
+ (should run-kbqf))
+ (remove-hook 'buffer-list-update-hook bluh))))
+
+(ert-deftest buffer-tests-inhibit-buffer-hooks-indirect ()
+ "Indirect buffers do not call `get-buffer-create'."
+ (dolist (inhibit '(nil t))
+ (let ((base (get-buffer-create "foo" inhibit)))
+ (unwind-protect
+ (dotimes (_i 11)
+ (let* (flag*
+ (flag (lambda () (prog1 t (setq flag* t))))
+ (indirect (make-indirect-buffer base "foo[indirect]" nil
+ inhibit)))
+ (unwind-protect
+ (progn
+ (with-current-buffer indirect
+ (add-hook 'kill-buffer-query-functions flag nil t))
+ (kill-buffer indirect)
+ (if inhibit
+ (should-not flag*)
+ (should flag*)))
+ (let (kill-buffer-query-functions)
+ (when (buffer-live-p indirect)
+ (kill-buffer indirect))))))
+ (let (kill-buffer-query-functions)
+ (when (buffer-live-p base)
+ (kill-buffer base)))))))
+
+(ert-deftest zero-length-overlays-and-not ()
+ (with-temp-buffer
+ (insert "hello")
+ (let ((long-overlay (make-overlay 2 4))
+ (zero-overlay (make-overlay 3 3)))
+ ;; Exclude.
+ (should (= (length (overlays-at 3)) 1))
+ (should (eq (car (overlays-at 3)) long-overlay))
+ ;; Include.
+ (should (= (length (overlays-in 3 3)) 2))
+ (should (memq long-overlay (overlays-in 3 3)))
+ (should (memq zero-overlay (overlays-in 3 3))))))
+
+(ert-deftest test-remove-overlays ()
+ (with-temp-buffer
+ (insert "foo")
+ (make-overlay (point) (point))
+ (should (= (length (overlays-in (point-min) (point-max))) 1))
+ (remove-overlays)
+ (should (= (length (overlays-in (point-min) (point-max))) 0)))
+
+ (with-temp-buffer
+ (insert "foo")
+ (goto-char 2)
+ (make-overlay (point) (point))
+ ;; We only count zero-length overlays at the end of the buffer.
+ (should (= (length (overlays-in 1 2)) 0))
+ (narrow-to-region 1 2)
+ ;; We've now narrowed, so the zero-length overlay is at the end of
+ ;; the (accessible part of the) buffer.
+ (should (= (length (overlays-in 1 2)) 1))
+ (remove-overlays)
+ (should (= (length (overlays-in (point-min) (point-max))) 0))))
+
+(defun test-kill-buffer-auto-save (auto-save-answer body-func)
+ "Test helper for `kill-buffer-delete-auto-save' tests.
+
+Call BODY-FUNC with the current buffer set to a buffer visiting a
+temporary file. Around the call, mock the \"Buffer modified;
+kill anyway?\" and \"Delete auto-save file?\" prompts, answering
+\"yes\" for the former and AUTO-SAVE-ANSWER for the latter. The
+expectation should be the characters `?y' or `?n', or `nil' if no
+prompt is expected. The test fails if the \"Delete auto-save
+file?\" prompt does not either prompt is not issued as expected.
+Finally, kill the buffer and its temporary file."
+ (ert-with-temp-file file
+ (should (file-exists-p file))
+ (save-excursion
+ (find-file file)
+ (should (equal file (buffer-file-name)))
+ (let ((buffer (current-buffer))
+ (auto-save-prompt-happened nil))
+ (cl-letf (((symbol-function #'read-multiple-choice)
+ (lambda (prompt choices &rest _)
+ (should (string-search "modified; kill anyway?" prompt))
+ (let ((answer (assq ?y choices)))
+ (should answer)
+ answer)))
+ ((symbol-function #'yes-or-no-p)
+ (lambda (prompt)
+ (should (string-search "Delete auto-save file?" prompt))
+ (setq auto-save-prompt-happened t)
+ (pcase-exhaustive auto-save-answer
+ (?y t)
+ (?n nil)))))
+ (funcall body-func)
+ (should (equal (null auto-save-prompt-happened)
+ (null auto-save-answer))))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (set-buffer-modified-p nil)
+ (kill-buffer)))))))
+
+(ert-deftest test-kill-buffer-auto-save-default ()
+ (let ((kill-buffer-delete-auto-save-files nil))
+ (test-kill-buffer-auto-save
+ nil
+ (lambda ()
+ (let (auto-save)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save t)
+ (should (file-exists-p auto-save))
+ (kill-buffer (current-buffer))
+ (should (file-exists-p auto-save)))))))
+
+(ert-deftest test-kill-buffer-auto-save-delete-yes ()
+ (let ((kill-buffer-delete-auto-save-files t))
+ (test-kill-buffer-auto-save
+ ?y
+ (lambda ()
+ (let (auto-save)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save t)
+ (should (file-exists-p auto-save))
+ ;; This should delete the auto-save file.
+ (kill-buffer (current-buffer))
+ (should-not (file-exists-p auto-save)))))))
+
+(ert-deftest test-kill-buffer-auto-save-delete-no ()
+ (let ((kill-buffer-delete-auto-save-files t))
+ (test-kill-buffer-auto-save
+ ?n
+ (lambda ()
+ (let (auto-save)
+ (auto-save-mode t)
+ (insert "foo\n")
+ (should buffer-auto-save-file-name)
+ (setq auto-save buffer-auto-save-file-name)
+ (do-auto-save t)
+ (should (file-exists-p auto-save))
+ ;; This should not delete the auto-save file.
+ (kill-buffer (current-buffer))
+ (should (file-exists-p auto-save))
+ (delete-file auto-save))))))
(ert-deftest test-buffer-modifications ()
(ert-with-temp-file file
@@ -1683,7 +8468,7 @@ with parameters from the *Messages* buffer modification."
(insert "foo")
(should (buffer-modified-p))
(should-not (eq (buffer-modified-p) 'autosaved))
- (do-auto-save nil t)
+ (do-auto-save t t)
(should (eq (buffer-modified-p) 'autosaved))
(with-silent-modifications
(put-text-property 1 3 'face 'bold))
@@ -1707,7 +8492,7 @@ with parameters from the *Messages* buffer modification."
(restore-buffer-modified-p nil)
(should-not (buffer-modified-p))
(insert "bar")
- (do-auto-save nil t)
+ (do-auto-save t t)
(should (eq (buffer-modified-p) 'autosaved))
(insert "zot")
(restore-buffer-modified-p 'autosaved)
diff --git a/test/src/comp-resources/comp-test-funcs.el
b/test/src/comp-resources/comp-test-funcs.el
index 9092f040c8..03925d4d2e 100644
--- a/test/src/comp-resources/comp-test-funcs.el
+++ b/test/src/comp-resources/comp-test-funcs.el
@@ -211,10 +211,10 @@
(comp-tests-err-arith-f)
(arith-error (concat "arith-error "
(error-message-string err)
- " catched"))
+ " caught"))
(error (concat "error "
(error-message-string err)
- " catched"))))
+ " caught"))))
(defun comp-tests-condition-case-1-f ()
;; Bpushhandler Bpophandler
(condition-case
@@ -222,10 +222,10 @@
(comp-tests-err-foo-f)
(arith-error (concat "arith-error "
(error-message-string err)
- " catched"))
+ " caught"))
(error (concat "error "
(error-message-string err)
- " catched"))))
+ " caught"))))
(defun comp-tests-catch-f (f)
(catch 'foo
(funcall f)))
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 1edbd1777c..4e512098a3 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -298,9 +298,9 @@ Check that the resulting binaries do not differ."
(comp-deftest non-locals ()
"Test non locals."
(should (string= (comp-tests-condition-case-0-f)
- "arith-error Arithmetic error catched"))
+ "arith-error Arithmetic error caught"))
(should (string= (comp-tests-condition-case-1-f)
- "error Foo catched"))
+ "error Foo caught"))
(should (= (comp-tests-catch-f
(lambda () (throw 'foo 3)))
3))
@@ -823,7 +823,7 @@ Return a list of results."
(should (= (comp-tests-tco-f 1 0 10) 55))))
(defun comp-tests-fw-prop-checker-1 (_)
- "Check that inside `comp-tests-fw-prop-f' `concat' and `length' are folded."
+ "Check that inside `comp-tests-fw-prop-1-f' `concat' and `length' are
folded."
(should
(cl-notany
#'identity
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 1099fd0467..a9a45d5463 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -263,7 +263,7 @@ must evaluate to a regular expression string."
(ert-deftest module--test-assertions--load-non-live-object-with-global-copy ()
"Check that -module-assertions verify that non-live objects aren't accessed.
-This differs from `module--test-assertions-load-non-live-object'
+This differs from `module--test-assertions--load-non-live-object'
in that it stows away a global reference. The module assertions
should nevertheless detect the invalid load."
:tags (if (getenv "EMACS_EMBA_CI") '(:unstable))
diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el
index bb2f04e8ee..0e12e4dbd8 100644
--- a/test/src/eval-tests.el
+++ b/test/src/eval-tests.el
@@ -222,7 +222,7 @@ expressions works for identifiers starting with period."
(ert-deftest eval-tests/funcall-with-delayed-message ()
;; Check that `funcall-with-delayed-message' displays its message before
- ;; its function terminates iff the timeout is short enough.
+ ;; its function terminates if the timeout is short enough.
;; This also serves as regression test for bug#55628 where a short
;; timeout was rounded up to the next whole second.
diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el
index 9a2bd5cef3..7568d941d0 100644
--- a/test/src/fns-tests.el
+++ b/test/src/fns-tests.el
@@ -22,6 +22,7 @@
;;; Code:
(require 'cl-lib)
+(require 'ert)
(ert-deftest fns-tests-identity ()
(let ((num 12345)) (should (eq (identity num) num)))
@@ -29,9 +30,22 @@
(let ((lst '(11))) (should (eq (identity lst) lst))))
(ert-deftest fns-tests-random ()
- (should (integerp (random)))
- (should (>= (random 10) 0))
- (should (< (random 10) 10)))
+ (unwind-protect
+ (progn
+ (should-error (random -1) :type 'args-out-of-range)
+ (should-error (random 0) :type 'args-out-of-range)
+ (should (integerp (random)))
+ (should (= (random 1) 0))
+ (should (>= (random 10) 0))
+ (should (< (random 10) 10))
+ (should (equal (random "seed") (random "seed")))
+ ;; The probability of four calls being the same is low.
+ ;; This makes sure that the value isn't constant.
+ (should (not (= (random t) (random t) (random t) (random t))))
+ ;; Handle bignums.
+ (should (integerp (random (1+ most-positive-fixnum)))))
+ ;; Reset the PRNG seed after testing.
+ (random t)))
(ert-deftest fns-tests-length ()
(should (= (length nil) 0))
@@ -152,6 +166,8 @@
(,(string-to-multibyte "abc") < "abd")
(,(string-to-multibyte "abc") < ,(string-to-multibyte "abd"))
(,(string-to-multibyte "\x80") = ,(string-to-multibyte "\x80"))
+ ("Liberté, Égalité, Fraternité" = "Liberté, Égalité, Fraternité")
+ ("Liberté, Égalité, Fraternité" < "Liberté, Égalité, Sororité")
;; Cases concerning the ordering of raw bytes: these are
;; troublesome because the current `string<' order is not very useful as
@@ -841,6 +857,14 @@
(should-error (reverse (dot1 1)) :type 'wrong-type-argument)
(should-error (reverse (dot2 1 2)) :type 'wrong-type-argument))
+(ert-deftest test-cycle-equal ()
+ (should-error (equal (cyc1 1) (cyc1 1)))
+ (should-error (equal (cyc2 1 2) (cyc2 1 2))))
+
+(ert-deftest test-cycle-nconc ()
+ (should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
+ (should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
+
(ert-deftest test-cycle-plist-get ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
@@ -895,30 +919,47 @@
(should-error (plist-put d1 3 3) :type 'wrong-type-argument)
(should-error (plist-put d2 3 3) :type 'wrong-type-argument)))
-(ert-deftest test-cycle-equal ()
- (should-error (equal (cyc1 1) (cyc1 1)))
- (should-error (equal (cyc2 1 2) (cyc2 1 2))))
-
-(ert-deftest test-cycle-nconc ()
- (should-error (nconc (cyc1 1) 'tail) :type 'circular-list)
- (should-error (nconc (cyc2 1 2) 'tail) :type 'circular-list))
-
(ert-deftest plist-get/odd-number-of-elements ()
"Test that `plist-get' doesn't signal an error on degenerate plists."
(should-not (plist-get '(:foo 1 :bar) :bar)))
(ert-deftest plist-put/odd-number-of-elements ()
- "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726.";
- (should (equal (should-error (plist-put '(:foo 1 :bar) :zot 2)
- :type 'wrong-type-argument)
+ "Check for bug#27726."
+ (should (equal (should-error (plist-put (list :foo 1 :bar) :zot 2))
'(wrong-type-argument plistp (:foo 1 :bar)))))
(ert-deftest plist-member/improper-list ()
- "Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726.";
- (should (equal (should-error (plist-member '(:foo 1 . :bar) :qux)
- :type 'wrong-type-argument)
+ "Check for bug#27726."
+ (should (equal (should-error (plist-member '(:foo 1 . :bar) :qux))
'(wrong-type-argument plistp (:foo 1 . :bar)))))
+(ert-deftest test-plist ()
+ (let ((plist (list :a "b")))
+ (setq plist (plist-put plist :b "c"))
+ (should (equal (plist-get plist :b) "c"))
+ (should (equal (plist-member plist :b) '(:b "c"))))
+
+ (let ((plist (list "1" "2" "a" "b")))
+ (setq plist (plist-put plist (string ?a) "c"))
+ (should (equal plist '("1" "2" "a" "b" "a" "c")))
+ (should-not (plist-get plist (string ?a)))
+ (should-not (plist-member plist (string ?a))))
+
+ (let ((plist (list "1" "2" "a" "b")))
+ (setq plist (plist-put plist (string ?a) "c" #'equal))
+ (should (equal plist '("1" "2" "a" "c")))
+ (should (equal (plist-get plist (string ?a) #'equal) "c"))
+ (should (equal (plist-member plist (string ?a) #'equal) '("a" "c"))))
+
+ (let ((plist (list :a 1 :b 2 :c 3)))
+ (setq plist (plist-put plist ":a" 4 #'string>))
+ (should (equal plist '(:a 1 :b 4 :c 3)))
+ (should (equal (plist-get plist ":b" #'string>) 3))
+ (should (equal (plist-member plist ":c" #'string<) plist))
+ (dolist (fn '(plist-get plist-member))
+ (should-not (funcall fn plist ":a" #'string<))
+ (should-not (funcall fn plist ":c" #'string>)))))
+
(ert-deftest test-string-distance ()
"Test `string-distance' behavior."
;; ASCII characters are always fine
@@ -1334,23 +1375,6 @@
(should-error (append loop '(end))
:type 'circular-list)))
-(ert-deftest test-plist ()
- (let ((plist '(:a "b")))
- (setq plist (plist-put plist :b "c"))
- (should (equal (plist-get plist :b) "c"))
- (should (equal (plist-member plist :b) '(:b "c"))))
-
- (let ((plist '("1" "2" "a" "b")))
- (setq plist (plist-put plist (copy-sequence "a") "c"))
- (should-not (equal (plist-get plist (copy-sequence "a")) "c"))
- (should-not (equal (plist-member plist (copy-sequence "a")) '("a" "c"))))
-
- (let ((plist '("1" "2" "a" "b")))
- (setq plist (plist-put plist (copy-sequence "a") "c" #'equal))
- (should (equal (plist-get plist (copy-sequence "a") #'equal) "c"))
- (should (equal (plist-member plist (copy-sequence "a") #'equal)
- '("a" "c")))))
-
(ert-deftest fns--string-to-unibyte-multibyte ()
(dolist (str (list "" "a" "abc" "a\x00\x7fz" "a\xaa\xbbz" "\x80\xdd\xff"
(apply #'unibyte-string (number-sequence 0 255))))
diff --git a/test/src/font-tests.el b/test/src/font-tests.el
index 7e9669c651..683d331d75 100644
--- a/test/src/font-tests.el
+++ b/test/src/font-tests.el
@@ -115,7 +115,7 @@ expected font properties from parsing NAME.")
(defun test-font-parse ()
"Test font name parsing."
(interactive)
- (switch-to-buffer (generate-new-buffer "*Font Pase Test*"))
+ (switch-to-buffer (generate-new-buffer "*Font Parse Test*"))
(setq show-trailing-whitespace nil)
(let ((pass-face '((t :foreground "green")))
(fail-face '((t :foreground "red"))))
diff --git a/test/src/lcms-tests.el b/test/src/lcms-tests.el
index 1829a7ea1f..7f0f660d13 100644
--- a/test/src/lcms-tests.el
+++ b/test/src/lcms-tests.el
@@ -28,7 +28,7 @@
;; https://github.com/njsmith/colorspacious
;; Other references:
-;;
http://www.babelcolor.com/index_htm_files/A%20review%20of%20RGB%20color%20spaces.pdf
+;;
https://www.babelcolor.com/index_htm_files/A%20review%20of%20RGB%20color%20spaces.pdf
;;; Code:
diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el
index ff0d6be3f5..b323f592dc 100644
--- a/test/src/regex-emacs-tests.el
+++ b/test/src/regex-emacs-tests.el
@@ -867,4 +867,9 @@ This evaluates the TESTS test cases from glibc."
(should (equal (string-match "[[:lower:]]" "ẞ") 0))
(should (equal (string-match "[[:upper:]]" "ẞ") 0))))
+(ert-deftest regexp-atomic-failure ()
+ "Bug#58726."
+ (should (equal (string-match "\\`\\(?:ab\\)*\\'" "a") nil))
+ (should (equal (string-match "\\`a\\{2\\}*\\'" "a") nil)))
+
;;; regex-emacs-tests.el ends here
diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el
index 5af4392301..be4f60ab57 100644
--- a/test/src/sqlite-tests.el
+++ b/test/src/sqlite-tests.el
@@ -241,4 +241,17 @@
(should (multibyte-string-p c1))
(should-not (multibyte-string-p c2)))))))
+(ert-deftest sqlite-returning ()
+ (skip-unless (sqlite-available-p))
+ (let (db)
+ (progn
+ (setq db (sqlite-open))
+ (sqlite-execute db "CREATE TABLE people1 (people_id INTEGER PRIMARY KEY,
first TEXT, last TEXT)")
+ (should (null (sqlite-select db "select * from people1")))
+ (should
+ (equal
+ (sqlite-execute db "INSERT INTO people1 (first, last) values (?, ?)
RETURNING people_id, first"
+ '("Joe" "Doe"))
+ '((1 "Joe")))))))
+
;;; sqlite-tests.el ends here
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index 75d67140a9..731fa893c1 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -217,7 +217,7 @@
(while (not threads-mutex-key)
(thread-yield))
(thread-signal thr 'quit nil)
- ;; `quit' is not catched by `should-error'. We must indicate it.
+ ;; `quit' is not caught by `should-error'. We must indicate it.
(condition-case nil
(thread-join thr)
(quit (signal 'error nil)))))))
- feature/tree-sitter updated (9f7ae2be60 -> 3f37f6b435), Yuan Fu, 2022/11/21
- feature/tree-sitter aa6958c04e 1/8: ; * src/treesit.c (treesit_load_language): Move call to eassume., Yuan Fu, 2022/11/21
- feature/tree-sitter b2ea38ab03 4/8: ; Minor fix in c-ts-mode fontification, Yuan Fu, 2022/11/21
- feature/tree-sitter 0cbb7d3bd0 2/8: Further tweak tree-sitter fontification heuristics, Yuan Fu, 2022/11/21
- feature/tree-sitter 6cf8bf5042 3/8: Allow major modes to tweak tree-sitter fontification, Yuan Fu, 2022/11/21
- feature/tree-sitter eb1a35adc1 7/8: ; Update tree-sitter starter guide, Yuan Fu, 2022/11/21
- feature/tree-sitter abf40a41aa 6/8: ; Fix typo in c-ts-mode--font-lock-settings, Yuan Fu, 2022/11/21
- feature/tree-sitter 3f37f6b435 8/8: ; * test/src/treesit-tests.el (treesit-misc): Remove test., Yuan Fu, 2022/11/21
- feature/tree-sitter aaeaa310f0 5/8: Merge remote-tracking branch 'savannah/master' into feature/tree-sitter,
Yuan Fu <=